C          DATA SET AMUD       AT LEVEL 002 AS OF 01/25/79
      REAL FUNCTION AMUD*8(X,Y)                                         00001
      IMPLICIT REAL*8(A-H,O-Z)                                          00002
C                                                                       00003
C                                                                       00004
C     REAL FUNCTION AMUD*8 (X,Y)                                        00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF AMUD IS TO CALCULATE THE REMAINDER PORTION OF THE  00009
C         QUOTIENT X/Y.                                                 00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     INPUT/OUTPUT VARIABLES ARE DEFINED AS FOLLOWS.                    00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C           X        R*8      I      NUMERATOR                          00018
C           Y        R*8      I      DENOMINATOR                        00019
C         AMUD(X,Y)  R*8      O      REMAINDER OF X/Y (EQUAL TO         00020
C                                       ZERO WHEN Y=0)                  00021
C                                                                       00022
C                                                                       00023
C                                                                       00024
C     AMUD IS CALLED BY THE FOLLOWING SUBROUTINES.                      00025
C                                                                       00026
C         ARCO      EHA                                                 00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C     NO SUBROUTINES ARE CALLED BY AMUD.                                00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C     AMUD NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00035
C         ALL INPUT AND OUTPUT IS THROUGH THE FUNCTION STATEMENT.       00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
      IF(Y.EQ.0.D0) GO TO 10                                            00040
      K=X/Y                                                             00041
      AMUD = X-K*Y                                                      00042
      IF(AMUD .LT. 0.0D0) AMUD=AMUD+Y                                   00043
      RETURN                                                            00044
   10 AMUD = 0.D0                                                       00045
      RETURN                                                            00046
      END                                                               00047
C          DATA SET ANGMOM     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE ANGMOM (INC,NODE,H)                                    00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
      REAL*8 INC,NODE                                                   00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE ANGMOM (INC,NODE,H)                                    00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF ANGMOM IS TO COMPUTE THE ANGULAR MOMENTUM UNIT     00000100
C         VECTOR OF AN ORBIT.                                           00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          INC       R*8      I      INCLINATION (RADIANS)              00000190
C          NODE      R*8      I      RIGHT ASCENSION OF THE             00000200
C                                       ASCENDING NODE (RADIANS)        00000210
C          H(3)      R*8      O      ANGULAR MOMENTUM UNIT VECTOR       00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C     ANGMOM IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000260
C                                                                       00000270
C         ESSO      INSERT                                              00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     NO SUBROUTINES ARE CALLED BY ANGMOM.                              00000330
C                                                                       00000340
C                                                                       00000350
C                                                                       00000360
C     ANGMOM NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000370
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
      DIMENSION H(3)                                                    00000420
      H(1) = DSIN(NODE)*DSIN(INC)                                       00000430
      H(2) = -DCOS(NODE) * DSIN(INC)                                    00000440
      H(3) = DCOS(INC)                                                  00000450
      RETURN                                                            00000460
      END                                                               00000470
C          DATA SET APEFEM     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE APEFEM(TD,IB,RP,VP,KN)                                 00000010
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000020
      DIMENSION EB58(56),EB114(38)                                      00000030
C                                                                       00000040
C                                                                       00000050
C                                                                       00000060
C     SUBROUTINE APEFEM (TD,IB,RP,VP,KN)                                00000070
C                                                                       00000080
C                                                                       00000090
C                                                                       00000100
C     THE PURPOSE OF APEFEM IS TO COMPUTE AN APPROXIMATE EPHEMERIS OF A 00000110
C         CELESTIAL BODY USING MEAN ELEMENTS.                           00000120
C                                                                       00000130
C                                                                       00000140
C                                                                       00000150
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000160
C                                                                       00000170
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000180
C                                                                       00000190
C          TD        R*8      I      DATE AND TIME IN SECONDS FROM      00000200
C                                       1950.0                          00000210
C          IB        I*4      I      BODY NUMBER                        00000220
C          RP(3)     R*8      O      CARTESIAN POSTION COORDINATES OF   00000230
C                                       BODY IB WITH RESPECT TO ITS     00000240
C                                       CENTRAL BODY (REFERENCED TO THE 00000250
C                                       EARTH'S MEAN EQUATOR OR ECLIPTIC00000260
C                                       AND THE EQUINOX OF DATE). UNITS 00000270
C                                       ARE ASTRONOMICAL UNITS.         00000280
C          VP(3)     R*8      0      CARTESIAN VELOCITY COORDINATES OF  00000290
C                                       BODY IB IN SAME SYSTEM AS RP.   00000300
C                                       UNITS ARE ASTRONOMICAL UNITS PER00000310
C                                       JULIAN CENTURY. (VP IS COMPUTED 00000320
C                                       ONLY IF KN IS POSITIVE.)        00000330
C          KN        I*4      I      COMPUTATION KEY--                  00000340
C                                       KN.GT.O    COMPUTE RP AND VP    00000350
C                                       KN.LT.O    COMPUTE RP           00000360
C                                       KN.EQ.2,-2 OUTPUT IN ECLIPTIC   00000370
C                                                   COORDINATES         00000380
C                                       KN.NE.2,-2 OUTPUT IN EQUATORIAL 00000390
C                                                   COORDINATES         00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C     APEFEM IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000440
C                                                                       00000450
C         PCONIK                                                        00000460
C                                                                       00000470
C                                                                       00000480
C                                                                       00000490
C     THE FOLLOWING SUBROUTINE IS CALLED BY APEFEM.                     00000500
C                                                                       00000510
C         UPELM                                                         00000520
C                                                                       00000530
C                                                                       00000540
C                                                                       00000550
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000560
C                                                                       00000570
C         COMMON VARIABLES USED                                         00000580
C                                                                       00000590
C           T(4)                                                        00000600
C                                                                       00000610
C                                                                       00000620
C                                                                       00000630
C         COMMON VARIABLES USED AND COMPUTED                            00000640
C                                                                       00000650
C           EL(10)                                                      00000660
C                                                                       00000670
C                                                                       00000680
C                                                                       00000690
C                                                                       00000700
C     XL=MEAN LONGITUDE                                                 00000710
C     WBAR=LONGITUDE 0F PERIHELION                                      00000720
C     ECCEN=ORBITAL ECCENTRICITY                                        00000730
C     XI=ORBITAL INCLINATION TO ECLIPTIC PLANE                          00000740
C     A=SEMI-MAJOR AXIS IN A.U.                                         00000750
C     OMEGN=ECLIPTIC LONGITUDE OF ASCENDING NODE                        00000760
C     TAU=MODIFIED TIME VARIABLE                                        00000770
C     XLD=DERIVATIVE OF L WITH RESPECT TO TAU                           00000780
C     WBARD=DERIVATIVE OF WBAR WITH RESPECT TO TAU                      00000790
C     ECCEND=DERIVATIVE OF ECCEN WITH RESPECT TO TAU                    00000800
C     XID=DERIVATIVE OF XI WITH RESPECT TO TAU                          00000810
C     OMEGND=DERIVATIVE OF OMEGN WITH RESPECT TO TAU                    00000820
C     TD=DERIVATIVE OF T WITH RESPECT TO TAU                            00000830
      DIMENSION     EB(151),  NEB(5,10),SMA(10),  RP(3),    VP(3)       00000840
     1,             EL(10),   NLOC(10), SIM(8),   COEF(6)               00000850
C                                                                       00000860
      DOUBLE PRECISION   EB,       EL,       SM,       S2M,      S3M    00000870
     1,        S4M,      S5M,      S6M,      S7M,      S8M,      SIM    00000880
     2,        CM,       CON,      DSIN,     DCOS,     DSQRT,    TT     00000890
     3,        XL,       WBAR,     ECCEN,    XI,       OMEGN,    COEF   00000900
     4,        XLD,      WBARD,    ECCEND,   XID,      OMEGND           00000910
C                                                                       00000920
      DOUBLE PRECISION   TEMP,     CV,       SV,       R,        W      00000930
     1,        CW,       SW,       CWV,      SWV,      SOMEGN           00000940
     2,        COMEGN,   SI,       CI,       ED,       CED,      SED    00000950
     3,        CVD,      SVD,      RD,       WD,       CWD,      SWD    00000960
     4,        CWVD,     SWVD,     SOMEGD,   COMEGD,   SID,      CID    00000970
     5,        PI,       PI2,      C,        EP,       CEP,      SEP    00000980
     6,        CE,       SE,       X,        Y,        Z,        XD     00000990
     7,        YD,       ZD,       XMD,      E,        XM               00001000
     8,   DE,  EC                                                       00001010
      DOUBLE PRECISION   XO(6),    TD,       SPJC                       00001020
C                                                                       00001030
      COMMON/APCOM/ T(4),     EL                                        00001040
      DOUBLE PRECISION   T                                              00001050
      EQUIVALENCE (EB(58),EB58(1)),(EB(114),EB114(1))                   00001060
      EQUIVALENCE (EL(1),XL),(EL(2),WBAR),(EL(5),ECCEN)                 00001070
     1,(EL(4),XI),  (EL(3),OMEGN), (EL(6),XLD),   (EL(7),WBARD)         00001080
     2,(EL(9),XID), (EL(10),ECCEND),(EL(8 ),OMEGND)                     00001090
      EQUIVALENCE       (SIM(1),SM),  (SIM(2),S2M),  (SIM(3),S3M)       00001100
     1,(SIM(4),S4M),    (SIM(5),S5M), (SIM(6),S6M),  (SIM(7),S7M)       00001110
     2,(SIM(8),S8M)                                                     00001120
      EQUIVALENCE  (XO(1),X),        (XO(2),Y),        (XO(3),Z)        00001130
      EQUIVALENCE  (XO(4),XD),       (XO(5),YD),       (XO(6),ZD)       00001140
C                                                                       00001150
      DIMENSION RT(3),TEMT(3,3),UP(3),DOW(3),TEMP1(3),ERROR(3)          00001160
      EQUIVALENCE (TEMT(1,1),RT(1)),(TEMT(1,2),DOW(1)),(TEMT(1,3),UP(1))00001170
C                                                                       00001180
      DATA SMA /.3870984D0,.72333015D0,1.00000023D0,1.52368839D0,       00001190
     15.202561D0,9.554747D0,19.21814D0,30.10957D0,39.517738D0,.25695316D00001200
     2-2 /                                                              00001210
      DATA EB /                                                         00001220
C     MERCURY                                                           00001230
     1 641444.68D0,      538106654.8D0, 1.084D0                         00001240
     2,273238.91D0,      5599.76D0,     1.061D0                         00001250
     3,169725.4D0,       4266.75D0,     .626D0                          00001260
     4,25210.37D0,       6.699D0,      -.066D0                          00001270
     5,.20561421D0,      .2046D-4,    -.3D-7                            00001280
C     VENUS                                                             00001290
     1,1233961.39D0,     210669162.88D0,1.1148D0                        00001300
     2,468589.8D0,       5068.93D0,     -3.515D0                        00001310
     3,272806.73D0,      3239.46D0,     1.476D0                         00001320
     4,12217.07D0,       3.621D0,       -.35D-2                         00001330
     5,.682069D-2,       -.4774D-4,     -.91D-7                         00001340
C     EARTH                                                             00001350
     1,358908.04D0,      129602768.13D0,1.089D0                         00001360
     2,364395.D0,        6189.03D0,     1.63D0,        .012D0           00001370
C    3,0.                                                               00001380
C    4,0.                                                               00001390
     5,.01675104D0,      -.418D-4,     -.126D-6                         00001400
C     MARS                                                              00001410
     1,1057491.46D0,     68910117.33D0, 1.1184D0                        00001420
     2,1203185.53D0,     6626.73D0,     .4675D0,       -.0043D0         00001430
     3,175631.19D0,      2775.57D0,    -.005D0,        -.0192D0         00001440
     4,6661.2D0,         -2.43D0,       .0454D0                         00001450
     5,.0933129D0,    .92064D-4,    -.77D-7,    94*0.D0/                00001460
C     JUPITER                                                           00001470
      DATA EB58 /                                                       00001480
     1 856977.32D0,10930687.148D0,1.20486D0,-.5936D-2                   00001490
     2,45795.34D0,       5795.862D0,    3.80258D0,     -.01236D0        00001500
     3,357996.19D0,      3637.908D0,    1.268D0,       -.03064D0        00001510
     4,4711.45D0,        -20.506D0,     .014D0                          00001520
     5,.04833475D0,      .16418D-3,     -.4676D-6,     -.17D-8          00001530
C     SATURN                                                            00001540
     1,959631.76D0,      4404635.581D0, 1.16835D0,     -.021D0          00001550
     2,327953.38D0,      7050.297D0,    2.9749D0,      .0166D0          00001560
     3,406045.4D0,       3143.5025D0,   -.54785D0,     .0191D0          00001570
     4,8973.07D0,        -14.108D0,    -.05576D0,       .16D-3          00001580
     5,.05589232D0,      -.3455D-3,     .728D-6,       -.74D-9          00001590
C     URANUS                                                            00001600
     1,879110.89D0,      1547508.765D0, 1.13774D0,     -.2176D-2        00001610
     2,617575.14D0,      5343.958D0,    .8539D0,       -.218D-2         00001620
     3,264517.55D0,      1795.204D0,    4.722D0                         00001630
     4,2780.87D0,        2.251D0,       .1422D0                         00001640
     5,.0463444D0,       -.2658D-4,     .77D-7   /                      00001650
C     NEPTUNE                                                           00001660
      DATA EB114 /                                                      00001670
     1 304048.78D0,      791589.291D0,  1.15374D0,     -.2176D-2        00001680
     2,168218.37D0,      5128.468D0,    1.40694D0,     -.2176D-2        00001690
     3,470452.89D0,      3956.166D0,    .89952D0,      -.16984D-1       00001700
     4,6405.27D0,        -34.357D0,     -.0328D0                        00001710
     5,.899704D-2,       .633D-5,       -.2D-8                          00001720
C     PLUTO                                                             00001730
     1,332716.402D0,     521686.943D0                                   00001740
     2,800913.9D0                                                       00001750
     3,392236.18D0                                                      00001760
     4,61728.4D0                                                        00001770
     5,.2486438D0                                                       00001780
C     MOON                                                              00001790
     1,973562.99D0,     1732564379.31D0,-4.08D0,       .0068D0          00001800
     2,1203586.4D0,      14648522.52D0, -37.17D0,    -.045D0            00001810
     3,933059.79D0,     -6962911.23D0,   7.48D0,       .008D0           00001820
     4,18523.428D0                                                      00001830
     5,.054900489D0               /                                     00001840
      DATA NEB   /                                                      00001850
     1 2,2,2,2,2                                                        00001860
     2,2,2,2,2,2                                                        00001870
     3,2,3,-1,-1,2                                                      00001880
     4,2,3,3,2,2                                                        00001890
     5,3,3,3,2,3                                                        00001900
     6,3,3,3,3,3                                                        00001910
     7,3,3,2,2,2                                                        00001920
     8,3,3,3,2,2                                                        00001930
     9,1,0,0,0,0                                                        00001940
     A,3,3,3,0,0/                                                       00001950
C                                                                       00001960
      DATA  NLOC/   1,   16,  31,  41,  58,  77,  97,  114, 132, 138/   00001970
      DATA PI,PI2      /3.1415926535897933D0,6.2831853071795866D0/      00001980
      DATA     SPJC / .315576D+10 /                                     00001990
C                                                                       00002000
      IF(IB.EQ.10) GO TO 100                                            00002010
      IBN=IB                                                            00002020
      NK = KN                                                           00002030
      IF(IBN .NE. 11) GO TO 20                                          00002040
      NK = 1                                                            00002050
C     THE MEAN VELOCITY IS REQUIRED IN DMOON                            00002060
      IBN = 10                                                          00002070
   20 CONTINUE                                                          00002080
      A=SMA(IBN)                                                        00002090
      LOC= NLOC(IBN)                                                    00002100
      TT = TD/SPJC+.5D0                                                 00002110
      CALL UPELM(EB(LOC),TT,NEB(1,IBN),NK)                              00002120
      DO 24 I=1,4                                                       00002130
      J=I+5                                                             00002140
      EL(I) = PI2*DMOD(EL(I)/1296000.D0,1.D0)                           00002150
   24 EL(J)=PI2*EL(J)/1296000.D0                                        00002160
C     FIND THE POSITION OF PLANET                                       00002170
      XM=XL-WBAR                                                        00002180
      EC = ECCEN                                                        00002190
      E=XM+EC*DSIN(XM)/(1.D0-.8D0*EC*DCOS(XM))                          00002200
   25 SE=DSIN(E)*EC                                                     00002210
      CE=1.D0-EC*DCOS(E)                                                00002220
      DE=XM-E+SE                                                        00002230
      DE=DE/(CE+SE*DE/(CE+SE*DE/CE))                                    00002240
      E=E+DE                                                            00002250
      IF(DABS(DE).GE.1.D-9) GO TO 25                                    00002260
      CE=DCOS(E)                                                        00002270
      SE=DSIN(E)                                                        00002280
      TEMP=1.0D0-ECCEN*CE                                               00002290
      CV=(CE-ECCEN)/TEMP                                                00002300
      SV=DSQRT(1.0D0-ECCEN**2)*SE/TEMP                                  00002310
      R=A*TEMP                                                          00002320
      W=WBAR-OMEGN                                                      00002330
      CW=DCOS(W)                                                        00002340
      SW=DSIN(W)                                                        00002350
      CWV=CW*CV-SW*SV                                                   00002360
      SWV=SW*CV+CW*SV                                                   00002370
      SOMEGN=DSIN(OMEGN)                                                00002380
      COMEGN=DCOS(OMEGN)                                                00002390
      SI=DSIN(XI)                                                       00002400
      CI=DCOS(XI)                                                       00002410
      X=R*(CWV*COMEGN-SWV*CI*SOMEGN)                                    00002420
      Y=R*(CWV*SOMEGN+SWV*CI*COMEGN)                                    00002430
      Z=R*SWV*SI                                                        00002440
      IF(NK.EQ.0) GO TO 50                                              00002450
C     FIND THE VELOCITY OF PLANET                                       00002460
      XMD=XLD-WBARD                                                     00002470
      ED=(XMD+ECCEND*SE)/TEMP                                           00002480
      CED=-SE*ED                                                        00002490
      SED=CE*ED                                                         00002500
      CVD=(CED-ECCEND+CV*(ECCEND*CE+ECCEN*CED))/TEMP                    00002510
      SVD=(((1.D0-ECCEN**2)*SED-ECCEN*ECCEND*SE)/DSQRT(1.D0-ECCEN**2)+SV00002520
     1*(ECCEND*CE+ECCEN*CED))/TEMP                                      00002530
      RD=A*(-ECCEND*CE-ECCEN*CED)                                       00002540
      WD=WBARD-OMEGND                                                   00002550
      CWVD=-SWV*WD+CW*CVD      -SW*SVD                                  00002560
      SWVD=CWV*WD+SW*CVD       +CW*SVD                                  00002570
      SOMEGD=COMEGN*OMEGND                                              00002580
      COMEGD=-SOMEGN*OMEGND                                             00002590
      SID=CI*XID                                                        00002600
      CID=-SI*XID                                                       00002610
      XD=RD*(X/R)+R*(CWVD*COMEGN+CWV*COMEGD-SWVD*CI*SOMEGN-SWV*CID*SOMEG00002620
     1N-SWV*CI*SOMEGD)                                                  00002630
      YD=RD*(Y/R)+R*(CWVD*SOMEGN+CWV*SOMEGD+SWVD*CI*COMEGN+SWV*CID*COMEG00002640
     1N+SWV*CI*COMEGD)                                                  00002650
      ZD=RD*SWV*SI+R*SWVD*SI+R*SWV*SID                                  00002660
   50 CONTINUE                                                          00002670
      C=PI/180.0D0                                                      00002680
      EP=C*(23.4522944D0-.0130125D0*T(2)-.1638889D-5*T(3)+.5027778D-6*T(00002690
     *4) )                                                              00002700
      CEP=DCOS(EP)                                                      00002710
      SEP=DSIN(EP)                                                      00002720
   52 CONTINUE                                                          00002730
      RP(1)=X                                                           00002740
      RP(2)=Y*CEP-Z*SEP                                                 00002750
      RP(3)=Z*CEP+Y*SEP                                                 00002760
      IF(NK.LE.0)  GO TO 100                                            00002770
      VP(1)=XD                                                          00002780
      VP(2)=YD*CEP-ZD*SEP                                               00002790
      VP(3)=ZD*CEP+YD*SEP                                               00002800
      IF(IABS(KN).EQ.2)  GO TO 100                                      00002810
  100 RETURN                                                            00002820
      END                                                               00002830
C          DATA SET ARCO       AT LEVEL 002 AS OF 11/07/78
      SUBROUTINE ARCO (JINS,HA,HB,AA,EA,ANOMA,ANOM,PHI,R,RINS)          00001
      IMPLICIT REAL*8 (A-H,O-Z)                                         00002
C                                                                       00003
C*****ARC-IN-ORBIT (ARCO) ROUTINE.                                      00004
C                                                                       00005
C                                                                       00006
C                                                                       00007
C     SUBROUTINE ARCO (JINS,HA,HB,AA,EA,ANOMA,ANOM,PHI,R,RINS)          00008
C                                                                       00009
C                                                                       00010
C                                                                       00011
C     THE PURPOSES OF ARCO ARE--                                        00012
C                                                                       00013
C         1) TO COMPUTE THE LINE OF RELATIVE NODES BETWEEN THE PLANES OF00014
C            TWO ORBITS FROM THEIR ANGULAR MOMENTUM UNIT VECTORS.       00015
C         2) TO COMPUTE THE ANGLE BETWEEN AN ARBITRARY POINT ALONG ONE  00016
C            OF THE ORBITS AND THE PLANE CHANGE MANEUVER POINT.         00017
C         3) TO COMPUTE THE TRUE ANOMALY IN THAT ORBIT OF THE PLANE     00018
C            CHANGE MANEUVER POINT.                                     00019
C                                                                       00020
C                                                                       00021
C                                                                       00022
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00023
C                                                                       00024
C         ARGUMENT   TYPE    I/O        DEFINITION                      00025
C                                                                       00026
C         JINS       I*4      I      FLAG FOR CHOOSING BETWEEN THE TWO  00027
C                                       POSSIBLE MANEUVER POINTS --     00028
C                                          =+1, INSERT AT FIRST RELATIVE00029
C                                               NODE ENCOUNTERED        00030
C                                          =+2, INSERT AT SECOND        00031
C                                               RELATIVE NODE           00032
C                                               ENCOUNTERED             00033
C                                          =-1, INSERT AT RELATIVE NODE 00034
C                                               NEAREST TO APOGEE OF OLD00035
C                                               ORBIT                   00036
C                                          =-2, INSERT AT RELATIVE NODE 00037
C                                               NEAREST TO PERIGEE OF   00038
C                                               OLD ORBIT               00039
C          HA(3)     R*8      I      ANGULAR MOMENTUM UNIT VECTOR, OLD  00040
C                                       ORBIT                           00041
C          HB(3)     R*8      I      ANGULAR MOMENTUM UNIT VECTOR, NEW  00042
C                                       ORBIT                           00043
C          AA        R*8      I      SEMIMAJOR AXIS, OLD ORBIT          00044
C          EA        R*8      I      ECCENTRICITY, OLD ORBIT            00045
C          ANOMA     R*8      I      TRUE ANOMALY OF ARBITRARY POINT    00046
C                                       ALONG OLD ORBIT (RADIANS)       00047
C          ANOM      R*8      O      TRUE ANOMALY IN OLD ORBIT OF PLANE 00048
C                                       CHANGE MANEUVER POINT (RADIANS) 00049
C          PHI       R*8      O      CENTRAL ANGLE SUBTENDING ARC IN OLD00050
C                                       ORBIT BETWEEN ARBITRARY POINT   00051
C                                       AND PLANE CHANGE MANEUVER POINT 00052
C                                       (RADIANS)                       00053
C          R(3)      R*8     I/O     INPUT AS UNIT VECTOR TO ARBITRARY  00054
C                                       POINT ALONG OLD ORBIT           00055
C                                    OUTPUT AS UNIT VECTOR TO MANEUVER  00056
C                                       POINT (LIES ALONG LINE OF       00057
C                                       RELATIVE NODES)                 00058
C          RINS      R*8      O      MAGNITUDE OF VECTOR TO MANEUVER    00059
C                                       POINT                           00060
C                                                                       00061
C                                                                       00062
C                                                                       00063
C     ARCO IS CALLED BY THE FOLLOWING SUBROUTINE.                       00064
C                                                                       00065
C         INSERT                                                        00066
C                                                                       00067
C                                                                       00068
C                                                                       00069
C     THE FOLLOWING SUBROUTINES ARE CALLED BY ARCO.                     00070
C                                                                       00071
C         ARGROT    XPROD                                               00072
C                                                                       00073
C                                                                       00074
C                                                                       00075
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY ARCO.            00076
C                                                                       00077
C         AMUD      DOT                                                 00078
C                                                                       00079
C                                                                       00080
C                                                                       00081
C     ARCO NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00082
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00083
C                                                                       00084
C                                                                       00085
C                                                                       00086
C                                                                       00087
C                                                                       00088
C                                                                       00089
      LOGICAL L                                                         00090
      DIMENSION HA(3),HB(3),R(3),OMEGAB(3)                              00091
      DATA PI,TWOPI/ 3.1415926535897932D0,6.2831853071795864D0/         00092
C                                                                       00093
C*****LINE OF RELATIVE NODES UNIT VECTOR.                               00094
      CALL XPROD (HA,HB,OMEGAB,RINS,1)                                  00095
C                                                                       00096
C*****ANGLES TO THE 2 POSSIBLE INSERTION POINTS (ENDPOINTS OF LINE OF   00097
C     RELATIVE NODES) ARE SUBSCRIPTED 'AB' FOR REL. NODE GIVEN BY       00098
C     HA X HB AND 'BA' FOR REL. NODE GIVEN BY HB X HA.                  00099
      CALL ARGROT (R,OMEGAB,HA,PHIAB)                                   00100
      PHIBA = AMUD(PHIAB+PI,TWOPI)                                      00101
      ANOMAB= AMUD(ANOMA+PHIAB,TWOPI)                                   00102
      ANOMBA= AMUD(ANOMA+PHIBA,TWOPI)                                   00103
C                                                                       00104
C*****CHOOSE TYPE OF INSERTION OPTION.                                  00105
      IF ((JINS .EQ.-1) .OR. (JINS .EQ.-2)) GO TO 5                     00106
      IF ((JINS .EQ. 1) .OR. (JINS .EQ. 2)) GO TO 10                    00107
      WRITE (6,1001) JINS                                               00108
      STOP                                                              00109
C                                                                       00110
C*****INSERT AT NODE NEAREST TO APOGEE OR PERIGEE OF OLD ORBIT.         00111
C     DEFINE LOGICAL VARIABLE L.                                        00112
    5 L = ((ANOMAB .LE. PI/2.D0) .OR. (ANOMAB .GE. 1.5D0*PI))           00113
      IF(((JINS.EQ.-1).AND.L) .OR. ((JINS.EQ.-2).AND..NOT.L)) GO TO 8   00114
      PHI = PHIAB                                                       00115
      GO TO 14                                                          00116
    8 PHI = PHIBA                                                       00117
      GO TO 20                                                          00118
C                                                                       00119
C****INSERT AT 1ST OR 2ND RELATIVE NODE ENCOUNTERED.                    00120
   10 IF (JINS .EQ. 1)  PHI = DMIN1(PHIAB,PHIBA)                        00121
      IF (JINS .EQ. 2) PHI = DMAX1(PHIAB,PHIBA)                         00122
      IF (DABS(PHI-PHIBA) .LT. 1.D-5) GO TO 20                          00123
   14 ANOM = ANOMAB                                                     00124
      DO 15 J=1,3                                                       00125
   15 R(J) = OMEGAB(J)                                                  00126
      GO TO 100                                                         00127
   20 ANOM = ANOMBA                                                     00128
      DO 25 J=1,3                                                       00129
   25 R(J) =-OMEGAB(J)                                                  00130
  100 RINS = AA * (1.D0-EA**2.) / (1.D0 + EA*DCOS(ANOM))                00131
      RETURN                                                            00132
 1001 FORMAT (1H1, 'SUBROUTINE ARCO REPORTS FATAL ERROR. JINS=',I3,'    00133
     2**INVALID VALUE WAS INPUT FOR THIS FLAG. CHECK NAMELIST INPUT**') 00134
      END                                                               00135
C          DATA SET ARCTIM     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE ARCTIM (A,E,ANOM,TIME)                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE ARCTIM (A,E,ANOM,TIME)                                 00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF ARCTIM IS TO COMPUTE THE TIME NEEDED TO TRAVERSE   00000090
C         AN ORBITAL ARC WHICH IS SPECIFIED IN TERMS OF A TRUE ANOMALY  00000100
C         ANGLE.                                                        00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/0        DEFINITION                      00000170
C                                                                       00000180
C          A         R*8      I      SEMI-MAJOR AXIS (KM)               00000190
C          E         R*8      I      ECCENTRICITY                       00000200
C         ANOM       R*8      I      TRUE ANOMALY (RADIANS)             00000210
C         TIME       R*8      0      ARC TRAVERSAL TIME (SECONDS FROM   00000220
C                                       PERIGEE)                        00000230
C                                                                       00000240
C                                                                       00000250
C                                                                       00000260
C     ARCTIM IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000270
C                                                                       00000280
C         INSERT                                                        00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     THE FOLLOWING SUBROUTINE IS CALLED BY ARCTIM.                     00000330
C                                                                       00000340
C         MEANOM                                                        00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     ARCTIM NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000390
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
      U = 398600.8D0                                                    00000440
C     CALCULATE MEAN ANOMALY CORRESPONDING TO THE TRUE ANOMALY          00000450
      CALL MEANOM(E,ANOM,EANOM,AMEAN)                                   00000460
C     CALCULATE TIME                                                    00000470
      TIME =AMEAN/ (DSQRT(U/A**3.))                                     00000480
      RETURN                                                            00000490
      END                                                               00000500
C          DATA SET ARGROT     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE ARGROT (A,B,C,Q)                                       00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE ARGROT (A,B,C,Q)                                       00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF ARGROT IS TO COMPUTE THE COUNTERCLOCKWISE ROTATION 00000090
C         ANGLE (0 TO TWO*PI RADIANS) FROM VECTOR A TO VECTOR B.        00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          A(3)      R*8      I      FIRST VECTOR                       00000180
C          B(3)      R*8      I      SECOND VECTOR                      00000190
C          C(3)      R*8      I      OF THE 2 VECTORS NORMAL TO THE     00000200
C                                       PLANE OF A AND B, C IS THE ONE  00000210
C                                       PRODUCED BY APPLYING THE RIGHT- 00000220
C                                       HAND RULE TO A COUNTERCLOCKWISE 00000230
C                                       ROTATION FROM A TO B.           00000240
C          Q         R*8      O      COUNTERCLOCKWISE ANGLE FROM A TO B 00000250
C                                       (0 TO TWO*PI RADIANS)           00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     ARGROT IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000300
C                                                                       00000310
C         ARCO      INSERT                                              00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     THE FOLLOWING SUBROUTINE IS CALLED BY ARGROT.                     00000360
C                                                                       00000370
C         XPROD                                                         00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY ARGROT.            00000420
C                                                                       00000430
C         DOT                                                           00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     ARGROT NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000480
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
      DIMENSION A(3),B(3),C(3),D(3)                                     00000530
      DATA TWOPI /6.2831853071795864D0/                                 00000540
      AMAG = DSQRT(A(1)*A(1)+A(2)*A(2)+A(3)*A(3))                       00000550
      BMAG = DSQRT(B(1)*B(1)+B(2)*B(2)+B(3)*B(3))                       00000560
      COSQ = DOT(A,B)/(AMAG*BMAG)                                       00000570
      CALL XPROD (C,A,D,DMAG,0)                                         00000580
      SINQ = DOT(B,D)/(BMAG*DMAG)                                       00000590
      Q    = DATAN2(SINQ,COSQ)                                          00000600
      IF (Q .LT. 0.D0) Q = Q + TWOPI                                    00000610
      RETURN                                                            00000620
      END                                                               00000630
C          DATA SET BADANG     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE BADANG (IA,NA,IB,NB,J,K,NTEST)                         00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
      REAL*8 IA,IB,NA,NB                                                00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE BADANG (IA,NA,IB,NB,J,K,NTEST)                         00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF BADANG IS TO CHECK FOR PROBLEMATIC INCLINATIONS AND00000100
C         NODES.                                                        00000110
C                                                                       00000120
C         1)IF INPUT INCLINATION IS ZERO, THE NODE INPUT IS OVERRIDDEN  00000130
C           AND SET TO ZERO.                                            00000140
C         2)IF INPUT INCLINATION IS NOT BETWEEN 0 AND 90 DEGREES,       00000150
C           PROGRAM TERMINATES.                                         00000160
C         3)IF THE TWO ORBITAL PLANES INVOLVED IN A MANEUVER ARE        00000170
C           COINCIDENT, PROGRAM TERMINATES.                             00000180
C                                                                       00000190
C                                                                       00000200
C                                                                       00000210
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000220
C                                                                       00000230
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000240
C                                                                       00000250
C          IA        R*8      I      INCLINATION OF ORBIT J (RADIANS)   00000260
C          NA        R*8      I      RIGHT ASCENSION OF ASCENDING NODE  00000270
C                                       OF ORBIT J (RADIANS)            00000280
C          IB        R*8      I      INCLINATION OF ORBIT K (RADIANS)   00000290
C          NB        R*8      I      RIGHT ASCENSION OF ASCENDING NODE  00000300
C                                       OF ORBIT K (RADIANS)            00000310
C          J,K       I*4      I      NUMBERS SIGNIFYING WHICH ORBITS OF 00000320
C                                       THE MISSION SEQUENCE ARE        00000330
C                                       INVOLVED IN THIS MANEUVER. 1ST  00000340
C                                       AND 2ND CHECKS LISTED ABOVE ARE 00000350
C                                       PERFORMED ON ORBIT K.           00000360
C          NTEST     I*4      I      TEST FLAG --                       00000370
C                                       IF .NE. 0, PERFORM 3RD CHECK    00000380
C                                                  LISTED ABOVE. PROGRAM00000390
C                                                  TERMINATES IF BOTH   00000400
C                                                  INCLINATIONS AND BOTH00000410
C                                                  NODES ARE WITHIN     00000420
C                                                  1.D-5 RADIANS OF     00000430
C                                                  EACH OTHER.          00000440
C                                       IF .EQ. 0, BYPASS 3RD CHECK.    00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
C     BADANG IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000490
C                                                                       00000500
C         MODE DRIVERS                                                  00000510
C                                                                       00000520
C                                                                       00000530
C                                                                       00000540
C     NO SUBROUTINES ARE CALLED BY BADANG.                              00000550
C                                                                       00000560
C                                                                       00000570
C                                                                       00000580
C     BADANG NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000590
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000600
C                                                                       00000610
C                                                                       00000620
C                                                                       00000630
C   **1. IF INCLINATION OF NEW ORBIT = 0., NODE INPUT IS OVERRIDDEN AND 00000640
C     SET TO ZERO.                                                      00000650
      PI = 3.1415926535897932D0                                         00000660
      IF ((IB .EQ. 0.D0) .AND. (NB .NE. 0.D0)) WRITE (6,1000)           00000670
      IF (IB .EQ. 0.D0) NB=0.D0                                         00000680
C   **2. MAKE SURE 0. .LE. IB .LE. PI/2.                                00000690
      IF ((IB .LT. 0.D0) .OR. (IB .GT. PI/2.D0)) GO TO 10               00000700
C   **3. MAKE SURE THE 2 ORBITAL PLANES ARE NOT COINCIDENT, SINCE       00000710
C     IN THAT CASE INSERTION COULD TAKE PLACE ANYWHERE (INSERTION POINTS00000720
C     UNDEFINED).  (IN THAT CASE USE A DIFFERENT MODE, WITH APPROPRIATE 00000730
C     CONSTRAINTS.)                                                     00000740
C    *(IGNORE THIS TEST IF THERE ARE NO INSERTION CALC'S INTO ORBIT K.) 00000750
      IF (NTEST .EQ. 0) RETURN                                          00000760
      IF  ( (DABS(IB-IA) .LE. 1.D-5)  .AND.  (DABS(NB-NA) .LE. 1.D-5) ) 00000770
     2     GO TO 20                                                     00000780
      RETURN                                                            00000790
   10 WRITE(6,1001)                                                     00000800
      STOP                                                              00000810
   20 WRITE(6,1002) J,K,IA,IB,NA,NB                                     00000820
      STOP                                                              00000830
 1000 FORMAT(1H0,'BADANG WARNING MESSAGE. AN INPUT NODE VALUE HAS BEEN O00000840
     2VERRIDDEN.  FOR ZERO INCLINATION, NODE INTERNALLY SET TO ZERO.')  00000850
 1001 FORMAT (1H0,'BADANG FATAL MESSAGE. AN INPUT INCLINATION WAS INVALI00000860
     *D. INCLINATION SHOULD NEVER BE LESS THAN ZERO OR GREATER THAN PI/200000870
     *.')                                                               00000880
 1002 FORMAT (1H0,'BADANG FATAL MESSAGE.  THE ORBITAL PLANES ',I1,' AND 00000890
     *',I1,' ARE COINCIDENT. AN ALTERNATE MODE IS REQUIRED.'/'0INCA=',  00000900
     *D13.6,'  INCB=',D13.6,'     NODEA=',D13.6,'  NODEB=',D13.6)       00000910
      END                                                               00000920
C          DATA SET BLANK      AT LEVEL 015 AS OF 01/22/79
C          DATA SET BLANK      AT LEVEL 006 AS OF 01/02/79              00001
      SUBROUTINE BLANK(S,A,EL,XMU,XMI,XMF,FL,FH,WS,RIE,SEPB,SEPA,       00002
     *                 KSUB,ISEN,FBAD)                                  00003
      IMPLICIT REAL*8(A-H,O-Z)                                          00004
      DIMENSION EL(6),R(3),RR(3),FL(5),FH(5),A(3),S(3),P(3)             00005
      DIMENSION Q(3),V(3)                                               00006
C    THE PURPOSE OF BLANK IS TO DETERMINE IF THERE IS SUN INTERFERENCE  00007
C  WITH THE EARTH SENSOR ALONG A SPECIFIED ARC IN THE ORBIT.  THE SUN   00008
C  POSITION AND ANGULAR WIDTH ARE ASSUMED TO REMAIN CONSTANT OVER THE  000009
C  ARC.  THE EARTH ANGULAR WIDTH IS RECOMPUTED AT SEVERAL POINTS IN THE 00010
C  ARC AND A TEST IS PERFORMED FOR SUN INTERFERENCE AT EACH POINT.      00011
C  SEVERAL EARTH SENSORS MAY BE INCLUDED IN THE TEST.  IF EVEN ONE SEN- 00012
C  SOR HAS INTERFERENCE, THEN THE POINT IS CONDIDERED BAD.  THE FRAC-   00013
C  TION OF BAD POINTS ALONG THE ARC IS OUTPUT.                          00014
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.            00015
C    ARGUMENT    TYPE     I/O        DEFINITION                         00016
C       S         R*8      I       EARTH TO SUN UNIT VECTOR (ASSUMED TO 00017
C                                  BE THE SAME AS THE SATELLLITE TO SUN 00018
C                                  UNIT VECTOR)                         00019
C       A         R*8      I       POSITIVE SPIN AXIS UNIT VECTOR       00020
C       EL(6)     R*8      I       ARRAY OF ORBITAL ELEMENTS            00021
C         (1)     R*8      I       SEMIMAJOR AXIS                       00022
C         (2)     R*8      I       ECCENTRICITY                         00023
C         (3)     R*8      I       INCLINATION (RADIANS)                00024
C         (4)     R*8      I       NODE (RADIANS)                       00025
C         (5)     R*8      I       ARGUMENT OF PERIGEE (RADIANS)        00026
C         (6)     R*8      I       MEAN ANOMALY AT INSERTION (RAD)      00027
C       XMU       R*8      I       GRAVITATIONAL FACTOR                 00028
C       XMI       R*8      I       MEAN ANOMALY AT START OF             00029
C                                  TEST FOR SUN INTERFERENCE (RAD)      00030
C       XMF       R*8      I       MEAN ANOMALY AT END OF TEST          00031
C                                  FOR SUN INTERFERENCE (RAD)           00032
C       FL(5)     R*8      I       ARRAY OF ANGLES SPECIFYING LOWER     00033
C                                  LIMIT OF THE SENSOR FIELD OF VIEW    00034
C                                  MEASURED FROM THE POSITIVE SPIN      00035
C                                  AXIS (RAD)                           00036
C       FH(5)     R*8      I       ARRAY OF ANGLES SPECIFYING THE       00037
C                                  UPPER LIMIT ON THE SENSOR FIELD OF   00038
C                                  VIEW MEASURED FROM THE POSITIVE      00039
C                                  SPIN AXIS (RADIANS)  FH IS GREATER   00040
C                                  THAN FL                              00041
C       WS        R*8      I       ANGULAR HALF-WIDTH OF SUN AS SEEN    00042
C                                  BY SENSOR (RADIANS)                  00043
C       RIE       R*8      I       INFRARED RADIUS OF EARTH USED TO     00044
C                                  DETERMINE THE EARTH HALF-WIDTH AS    00045
C                                  SEEN BY THE SENSOR (RADIANS)         00046
C       SEPB      R*8      I       MINIMUM DIHEDRAL ANGULAR SEPARATION  00047
C                                  MEASURED IN THE DIRECTION FROM EDGE  00048
C                                  OF SUN TO EDGE OF INFRARED EARTH     00049
C                                  HORIZON TO AVOID SUN INTERFERENCE    00050
C                                  (RADIANS)                            00051
C       SEPA      R*8      I       MINIMUM DIHEDRAL ANGULAR SEPARATION  00052
C                                  MEASURED IN THE DIRECTION FROM EDGE  00053
C                                  OF INFRARED EARTH HORIZON TO EDGE OF 00054
C                                  SUN TO AVOID SUN INTERFERENCE (RAD)  00055
C       KSUB      I*4      I       NUMBER OF SUBINTERVALS FROM TI TO TF 00056
C       ISEN      I*4      I       NUMBER OF EARTH SENSORS BEING TESTED 00057
C                                  FOR POSSIBLE SUN INTERFERENCE        00058
C       FBAD      R*8      O       FRACTION OF POINTS ALONG ORBITAL ARC 00059
C                                  WHICH HAVE SUN INTERFERENCE          00060
C  THE FOLLOWING SUBROUTINES ARE CALLED BY BLANK                        00061
C     DOT      JOHANN                                                   00062
C     ELMREC   XPROD                                                    00063
      DATA D2R/.174532925199D-1/,R2D/57.2957795131D0/                   00064
      DATA TOL/1.0D-4/                                                  00065
      JSUM = 0                                                          00066
      DM = (XMF-XMI)/KSUB                                               00067
      X1 = XMI*R2D                                                      00068
C  COMPUTE TRUE ANOMALY AT START OF TEST SPAN                           00069
      CALL JOHANN(EL(2),X1,TOL,TA,KK)                                   00070
C  COMPUTE RASIUS VECTOR AT ATART                                       00071
      EL(6) = TA*D2R                                                    00072
      JJ = 1                                                            00073
      E1=EL(1)                                                          00074
      E2=EL(2)                                                          00075
      E3=EL(3)                                                          00076
      E4=EL(4)                                                          00077
      E5=EL(5)                                                          00078
      E6=EL(6)                                                          00079
      CALL ELMREC(E1,E2,E3,E4,E5,E6,V,VM,JJ,RR,RM)                      00080
C  FIND UNIT RADIUS VECTOR EARTH TO S/C AT START                        00081
      R(1) = RR(1)/RM                                                   00082
      R(2) = RR(2)/RM                                                   00083
      R(3) = RR(3)/RM                                                   00084
      XM = XMI                                                          00085
C  BEGIN LOOP OVER MEAN ANOMALY                                         00086
      NPTS = KSUB+1                                                     00087
      DO 800 I=1,NPTS                                                   00088
C  COMPUTE SOLAR ASPECT ANGLE                                           00089
      ALPHA = DARCOS(DOT(A,S))                                          00090
C  COMPUTE NADIR ANGLE                                                  00091
      ETA = DARCOS(-DOT(A,R))                                           00092
C  CHECK FOR SUN OR EARTH IN SENSOR FIELD OF VIEW                       00093
      SL = ALPHA-WS                                                     00094
      SH = ALPHA+WS                                                     00095
      D = DATAN(RIE/RM)                                                 00096
      EP = ETA+D                                                        00097
      EM = ETA-D                                                        00098
      ITEST = 0                                                         00099
      DO 300 K=1,ISEN                                                   00100
      H = FH(K)                                                         00101
      B = FL(K)                                                         00102
      KS = 0                                                            00103
      IF((SH .GT. B .AND. SH .LT. H) .OR.                               00104
     *   (SL .GT. B .AND. SL .LT. H)) KS = 1                            00105
      IF(SL .LE. B .AND. SH .GE. H) KS=1                                00106
C  KS = 1 MEANS SENSOR K SEES THE SUN                                  000107
      KE = 0                                                            00108
      IF((EP .GT. B .AND. EP .LT. H) .OR.                               00109
     *   (EM .GT. B .AND. EM .LT. H)) KE = 1                            00110
      IF(EM .LE. B .AND. EP .GE. H) KE=1                                00111
C  KE = 1 MEANS SENSOR K SEES THE EARTH                                 00112
      IF(KS .EQ. 1 .AND. KE .EQ. 1) ITEST = 1                           00113
C  ITEST = 1 MEANS POSSIBLE SUN INTERFERENCE OF AT LEAST ONE EARTH      00114
C            SENSOR                                                     00115
  300 CONTINUE                                                          00116
      IF(ITEST .EQ. 0) GO TO 500                                        00117
C  COMPUTE UNIT VECTOR PERFENDICULAR TO SPIN ACIS AND RADIUS VECTOR     00118
      CALL XPROD(A,R,P,PM,1)                                            00119
C  COMPUTE DOT PRODUCT TO TEST WHERE SUN IS WITH RESPECT TO SPIN AXIS-  00120
C  RADIUS VECTOR PLANE                                                  00121
      F = DOT(S,P)                                                      00122
C  COMPUTE MINIMUM SEPERATION ANGLE (MEASURED FROM CENTER OF SUN TO     00123
C  CENTER OF SUN TO CENTER OF EARTH) FOR SWEEPING FROM SUN TO EARTH     00124
      STE = D+SEPB+WS                                                   00125
      ETS = D+SEPA+WS                                                   00126
C  COMPUTE UNIT VECTOR PERPENDICULAR TO SPIN AXIS AND SPACECRAFT TO     00127
C  SUN VECTOR                                                           00128
      CALL XPROD(S,A,Q,QM,1)                                            00129
C  COMPUTE DIHEDRAL SERARATION ANGLE BETWEEN SPIN AXIS- SUN PLANE AND   00130
C  SPIN AXIS- EARTH PLANE.                                              00131
      PHI = DARCOS(DOT(Q,P))                                            00132
C  TEST FOR SUN INTERFERENCE SWEEPING FROM SUN TO EARTH                 00133
      JTEST = 0                                                         00134
      IF(F .GT. 0.0 .AND. PHI .LT. STE) JTEST = 1                       00135
C  TEST FOR SUN INTERFERENCE SWEEPING FROM EARTH TO SUN                 00136
      IF(F .LT. 0.0 .AND. PHI .LT. ETS) JTEST = 1                       00137
C  JTEST = 1 MEANS THERE IS SUN INTERFERENCE WITH ONE OF THE EARTH      00138
C  SENSORS                                                              00139
      IF(JTEST .EQ. 1) JSUM=JSUM+1                                      00140
  500 CONTINUE                                                          00141
C  INCREMENT MEAN ANOMALY                                               00142
      XM = XM+DM                                                        00143
      XDEG = XM*R2D                                                     00144
C  CONVERT TO TRUE ANOMALY                                              00145
      CALL JOHANN(EL(2),XDEG,TOL,TA,KK)                                 00146
      EL(6) = TA*D2R                                                    00147
C  COMPUTE NEW RADIUS VECTOR                                           000148
      E1=EL(1)                                                          00149
      E2=EL(2)                                                          00150
      E3=EL(3)                                                          00151
      E4=EL(4)                                                          00152
      E5=EL(5)                                                          00153
      E6=EL(6)                                                          00154
      CALL ELMREC(E1,E2,E3,E4,E5,E6,V,VM,JJ,RR,RM)                      00155
      R(1) = RR(1)/RM                                                   00156
      R(2) = RR(2)/RM                                                   00157
      R(3) = RR(3)/RM                                                   00158
  800 CONTINUE                                                          00159
C   COMPUTE FRACTION OF POINTS ALONG ORBITAL ARC WHICH HAVE SUN INTER-  00160
C  FERENCE                                                              00161
      FBAD = DFLOAT(JSUM)/DFLOAT(NPTS)                                  00162
      RETURN                                                            00163
      END                                                               00164
C          DATA SET DATOUT     AT LEVEL 001 AS OF 11/06/78
      SUBROUTINE DATOUT (TW,TF,YW,YF,K)                                 00000010
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000020
      REAL*8 IY                                                         00000030
      DIMENSION Y(8),C(12),IY(4)                                        00000040
      EQUIVALENCE(Y(2),IY(1))                                           00000050
      DATA C/4H JAN,4H FEB,4H MAR,4H APR,4H MAY,4H JUN,4H JUL,4H AUG,   00000060
     1 4H SEP,4H OCT,4H NOV,4H DEC/                                     00000070
C                                                                       00000080
C                                                                       00000090
C     SUBROUTINE DATOUT (TW,TF,YW,YF,K)                                 00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     THE PURPOSE OF DATOUT IS TO CONVERT WHOLE AND/OR FRACTIONAL DAYS  00000140
C         SINCE 1950.0 (JANUARY 1,1950, 0 HRS, 0 MIN, 0.0 SEC) TO       00000150
C         CALENDAR DATE FORMAT. THE CALENDAR DATE AND ITS CORRESPONDING 00000160
C         JULIAN DATE ARE WRITTEN OUT BY DATOUT IF DESIRED.             00000170
C                                                                       00000180
C                                                                       00000190
C                                                                       00000200
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000210
C                                                                       00000220
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000230
C                                                                       00000240
C           TW       R*8      I      WHOLE DAYS SINCE 1950.0            00000250
C           TF       R*8      I      FRACTIONAL DAYS (MAY BE .GE. 1. DO)00000260
C           YW       R*8      O      CALENDAR DATE (YYMM.DD)            00000270
C           YF       R*8      O      TIME OF DAY (HHMM.SS)              00000280
C           K        I*4      I      PRINT FLAG                         00000290
C                                       .EQ.0 CALENDAR DATE AND JULIAN  00000300
C                                             DATE ARE PRINTED BY DATOUT00000310
C                                       .NE.0 NO PRINTOUT FROM DATOUT   00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     DATOUT IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000360
C                                                                       00000370
C         MODE DRIVERS                                                  00000380
C         SUNEPH                                                        00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C     THE FOLLOWING SUBROUTINE IS CALLED BY DATOUT.                     00000430
C                                                                       00000440
C         TFRAC                                                         00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
C     DATOUT NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000490
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
C                                                                       00000540
      CALL TFRAC (TW,TF,Y(7),Y(8))                                      00000550
C                                                                       00000560
C********DETERMINE IF INPUT FALLS WITHIN LIMITS (1950.0-2099, INCLUSIVE)00000570
C                                                                       00000580
      JJ = 1                                                            00000590
      IF(Y(7)+Y(8).LT.0.D0) GO TO 3                                     00000600
      IF(Y(7)+Y(8).LT.54787.D0) GO TO 10                                00000610
      JJ = 6                                                            00000620
    3 IF(JJ.EQ.1)WRITE(6,100)                                           00000630
      IF(JJ.EQ.6) WRITE(6,600)                                          00000640
      YF=0.D0                                                           00000650
      YW=0.D0                                                           00000660
      GO TO 999                                                         00000670
C                                                                       00000680
C********COMPUTE THE NUMBER OF DAYS REMAINING AFTER AN INTEGRAL NUMBER  00000690
C********OF YEARS SINCE 1950.0, AND DETERMINE IF CURRENT YEAR IS A LEAP 00000700
C********YEAR.                                                          00000710
C                                                                       00000720
   10 CONTINUE                                                          00000730
      IY(1)= IDINT(Y(7))                                                00000740
      IY(2)=IDINT(IY(1))/365                                            00000750
   11 IY(3)= IDINT(IY(1))-(1461*IDINT(IY(2))+1)/4                       00000760
      IF(IDINT(IY(3)).GE.0) GO TO 12                                    00000770
      IY(2)=IDINT(IY(2))-1                                              00000780
      GO TO 11                                                          00000790
   12 IY(4)=IDINT(IY(2))-2-4*(IDINT(IY(2))/4)                           00000800
C                                                                       00000810
C********DETERMINE THE MONTH, AND COMPUTE THE DAYS REMAINING IN THE     00000820
C********MONTH.                                                         00000830
C                                                                       00000840
      IY(2)=IDINT(IY(2))+50                                             00000850
      JJ = 0                                                            00000860
      KD = 0                                                            00000870
   13 CONTINUE                                                          00000880
      MD = KD                                                           00000890
      JJ = JJ+1                                                         00000900
      GO TO (14,16,14,15,14,15,14,14,15,14,15,14) ,JJ                   00000910
   14 KD = KD+31                                                        00000920
      GO TO 17                                                          00000930
   15 KD = KD+30                                                        00000940
      GO TO 17                                                          00000950
   16 IF(IDINT(IY(4)).EQ.0) KD=KD+1                                     00000960
      KD = KD+28                                                        00000970
   17 IF(KD.LE.IDINT(IY(3))) GO TO 13                                   00000980
      IY(1)=IDINT(IY(3))-MD+1                                           00000990
      Y(1) = C(JJ)                                                      00001000
      YW=DFLOAT(IDINT(IY(1))+100*(JJ+100*IDINT(IY(2))))/100.D0          00001010
      IY(2)=IDINT(IY(2))+1900                                           00001020
C                                                                       00001030
C********COMPUTE THE TIME OF DAY.                                       00001040
C                                                                       00001050
      Y(6)  = Y(8)*24.D0                                                00001060
      IY(3)=IDINT(Y(6))                                                 00001070
      Y(6)  = 60.D0*(Y(6)-      IY(3))                                  00001080
      IY(4)=IDINT(Y(6))                                                 00001090
      Y(6)  = 60.D0*(Y(6)-      IY(4))                                  00001100
      YY=IDINT(IY(4))+100*IDINT(IY(3))                                  00001110
      YF = YY+Y(6)/100.D0                                               00001120
C                                                                       00001130
C********DETERMINE IF PRINTOUT IS DESIRED.  IF SO, COMPUTE JULIAN DATE. 00001140
C                                                                       00001150
      IF (K.NE.0) GO TO 999                                             00001160
      Y(8) = Y(8)+0.5D0                                                 00001170
      YY=IDINT(Y(8))                                                    00001180
      Y(8) = Y(8)-YY                                                    00001190
      Y(7) = Y(7)+YY+2433282.D0                                         00001200
      IOUT2=IDINT(Y(2))                                                 00001210
      IOUT3=IDINT(Y(3))                                                 00001220
      IOUT4=IDINT(Y(4))                                                 00001230
      IOUT5=IDINT(Y(5))                                                 00001240
      WRITE(6,601) Y(1),IOUT2,IOUT3,IOUT4,IOUT5,Y(6),Y(7),Y(8)          00001250
  100 FORMAT (6X,'WARNING MESSAGE FROM DATOUT. DATE BEFORE 1950.0.')    00001260
  600 FORMAT (6X,'WARNING MESSAGE FROM DATOUT. DATE 2100 OR LATER.')    00001270
  601 FORMAT(A6,I3,1H,,I5,1H,,I3,5H HRS,,I3,5H MIN,,F7.3,4H SEC,/,1X,   00001280
     111HJULIAN DATE,F10.0,T22,F9.8)                                    00001290
  999 RETURN                                                            00001300
      END                                                               00001310
C          DATA SET DEFINE     AT LEVEL 002 AS OF 12/20/78
      SUBROUTINE DEFINE (MU,KODE)                                       00001
      IMPLICIT REAL*8 (A-H,O-Z)                                         00002
C                                                                       00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE DEFINE (MU,KODE)                                       00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF DEFINE IS TO PRINT THE DEFINITION OF EACH OUTPUT   00010
C         PARAMETER. THE DEFINITION IS PRINTED ON THE SAME UNIT AS THE  00011
C         TABULATION OF THE OUTPUT PARAMETER.                           00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/0        DEFINITION                      00018
C                                                                       00019
C          MU        I*4      I      PRINTER UNIT                       00020
C          KODE      I*4      I      CODE NUMBER OF THE OUTPUT PARAMETER00021
C                                                                       00022
C                                                                       00023
C                                                                       00024
C     DEFINE IS CALLED BY THE FOLLOWING SUBROUTINE.                     00025
C                                                                       00026
C         OUTFLO                                                        00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C     NO SUBROUTINES ARE CALLED BY DEFINE.                              00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C     DEFINE NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00035
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
C                                                                       00040
C *** SKIP TO DIFFERENT 'COMPUTED GO TO' STATEMENT FOR EVERY HUNDRED    00041
C     CODE NUMBERS.                                                     00042
      JODE = (KODE-1)/100                                               00043
      GO TO (1,2,3                                                ),JODE00044
      GO TO 50                                                          00045
C *** CODE NUMBERS 101 THROUGH 200                                      00046
    1 K = KODE - 100                                                    00047
      GO TO (101,102,103,104,105,106,107,108,109,110,111, 50, 50, 50, 5000048
     2      , 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 5000049
     3      , 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 5000050
     4      , 50, 50, 50, 50, 50,151,152,153,154,155,156,157,158,159,16000051
     5      ,161,162,163,164,165,166                                ),K 00052
      GO TO 50                                                          00053
C *** CODE NUMBERS 201 THROUGH 300                                      00054
    2 K = KODE - 200                                                    00055
      GO TO (201,202,203,204,205,206,207,208,209, 50, 50, 50, 50, 50, 5000056
     2      , 50, 50, 50, 50, 50,221,222,223,224,225,226,227,228,229,23000057
     3      ,231,232,233,234,235,236,237,238, 50, 50, 50, 50, 50, 50, 5000058
     4      , 50, 50, 50, 50, 50,251,252,253,254,255,256,257,258,259,26000059
     5      ,261,262,263,264,265,266,267,268,269,270,271,272,273,274),K 00060
      GO TO 50                                                          00061
C *** CODE NUMBERS 301 THROUGH 400                                      00062
    3 K = KODE - 300                                                    00063
      GO TO (301,302,303,304,305,306,307,308,309, 50, 50, 50, 50, 50, 5000064
     2      , 50, 50, 50, 50, 50,321,322,323,324,325,326,327,328,329,33000065
     3      ,331,332,333,334,335,336,337,338, 50, 50, 50, 50, 50, 50, 5000066
     4      , 50, 50, 50, 50, 50,351,352,353,354,355,356,357,358,359,36000067
     5      ,361,362,363,364,365,366,367,368,369,370,371,372,373,374),K 00068
      GO TO 50                                                          00069
C                                                                       00070
C                                                                       00071
C                                                                       00072
   50 WRITE (MU,1000)                                                   00073
      RETURN                                                            00074
C                                                                       00075
C                                                                       00076
C                                                                       00077
C*****WRITE THE APPROPRIATE DEFINITION.                                 00078
  101 WRITE (MU,9101)                                                   00079
      RETURN                                                            00080
  102 WRITE (MU,9102)                                                   00081
      RETURN                                                            00082
  103 WRITE (MU,9103)                                                   00083
      RETURN                                                            00084
  104 WRITE (MU,9104)                                                   00085
      RETURN                                                            00086
  105 WRITE (MU,9105)                                                   00087
      RETURN                                                            00088
  106 WRITE (MU,9106)                                                   00089
      RETURN                                                            00090
  107 WRITE (MU,9107)                                                   00091
      RETURN                                                            00092
  108 WRITE (MU,9108)                                                   00093
      RETURN                                                            00094
  109 WRITE (MU,9109)                                                   00095
      RETURN                                                            00096
  110 WRITE (MU,9110)                                                   00097
      RETURN                                                            00098
  111 WRITE (MU,9111)                                                   00099
      RETURN                                                            00100
  151 WRITE (MU,9151)                                                   00101
      RETURN                                                            00102
  152 WRITE (MU,9152)                                                   00103
      RETURN                                                            00104
  153 WRITE (MU,9153)                                                   00105
      RETURN                                                            00106
  154 WRITE (MU,9154)                                                   00107
      RETURN                                                            00108
  155 WRITE (MU,9155)                                                   00109
      RETURN                                                            00110
  156 WRITE (MU,9156)                                                   00111
      RETURN                                                            00112
  157 WRITE (MU,9157)                                                   00113
      RETURN                                                            00114
  158 WRITE (MU,9158)                                                   00115
      RETURN                                                            00116
  159 WRITE (MU,9159)                                                   00117
      RETURN                                                            00118
  160 WRITE (MU,9160)                                                   00119
      RETURN                                                            00120
  161 WRITE (MU,9161)                                                   00121
      RETURN                                                            00122
  162 WRITE (MU,9162)                                                   00123
      RETURN                                                            00124
  163 WRITE (MU,9163)                                                   00125
      RETURN                                                            00126
  164 WRITE (MU,9164)                                                   00127
      RETURN                                                            00128
  165 WRITE (MU,9165)                                                   00129
      RETURN                                                            00130
  166 WRITE (MU,9166)                                                   00131
      RETURN                                                            00132
C                                                                       00133
  201 WRITE (MU,9201)                                                   00134
      RETURN                                                            00135
  202 WRITE (MU,9202)                                                   00136
      RETURN                                                            00137
  203 WRITE (MU,9203)                                                   00138
      RETURN                                                            00139
  204 WRITE (MU,9204)                                                   00140
      RETURN                                                            00141
  205 WRITE (MU,9205)                                                   00142
      RETURN                                                            00143
  206 WRITE (MU,9206)                                                   00144
      RETURN                                                            00145
  207 WRITE (MU,9207)                                                   00146
      RETURN                                                            00147
  208 WRITE (MU,9208)                                                   00148
      RETURN                                                            00149
  209 WRITE (MU,9209)                                                   00150
      RETURN                                                            00151
  221 WRITE (MU,9221)                                                   00152
      RETURN                                                            00153
  222 WRITE (MU,9222)                                                   00154
      RETURN                                                            00155
  223 WRITE (MU,9223)                                                   00156
      RETURN                                                            00157
  224 WRITE (MU,9224)                                                   00158
      RETURN                                                            00159
  225 WRITE (MU,9225)                                                   00160
      RETURN                                                            00161
  226 WRITE (MU,9226)                                                   00162
      RETURN                                                            00163
  227 WRITE (MU,9227)                                                   00164
      RETURN                                                            00165
  228 WRITE (MU,9228)                                                   00166
      RETURN                                                            00167
  229 WRITE (MU,9229)                                                   00168
      RETURN                                                            00169
  230 WRITE (MU,9230)                                                   00170
      RETURN                                                            00171
  231 WRITE (MU,9231)                                                   00172
      RETURN                                                            00173
  232 WRITE (MU,9232)                                                   00174
      RETURN                                                            00175
  233 WRITE (MU,9233)                                                   00176
      RETURN                                                            00177
  234 WRITE (MU,9234)                                                   00178
      RETURN                                                            00179
  235 WRITE (MU,9235)                                                   00180
      RETURN                                                            00181
  236 WRITE (MU,9236)                                                   00182
      RETURN                                                            00183
  237 WRITE (MU,9237)                                                   00184
      RETURN                                                            00185
  238 WRITE (MU,9238)                                                   00186
      RETURN                                                            00187
  251 WRITE (MU,9251)                                                   00188
      RETURN                                                            00189
  252 WRITE (MU,9252)                                                   00190
      RETURN                                                            00191
  253 WRITE (MU,9253)                                                   00192
      RETURN                                                            00193
  254 WRITE (MU,9254)                                                   00194
      RETURN                                                            00195
  255 WRITE (MU,9255)                                                   00196
      RETURN                                                            00197
  256 WRITE (MU,9256)                                                   00198
      RETURN                                                            00199
  257 WRITE (MU,9257)                                                   00200
      RETURN                                                            00201
  258 WRITE (MU,9258)                                                   00202
      RETURN                                                            00203
  259 WRITE (MU,9259)                                                   00204
      RETURN                                                            00205
  260 WRITE (MU,9260)                                                   00206
      RETURN                                                            00207
  261 WRITE (MU,9261)                                                   00208
      RETURN                                                            00209
  262 WRITE (MU,9262)                                                   00210
      RETURN                                                            00211
  263 WRITE (MU,9263)                                                   00212
      RETURN                                                            00213
  264 WRITE (MU,9264)                                                   00214
      RETURN                                                            00215
  265 WRITE (MU,9265)                                                   00216
      RETURN                                                            00217
  266 WRITE (MU,9266)                                                   00218
      RETURN                                                            00219
  267 WRITE (MU,9267)                                                   00220
      RETURN                                                            00221
  268 WRITE (MU,9268)                                                   00222
      RETURN                                                            00223
  269 WRITE (MU,9269)                                                   00224
      RETURN                                                            00225
  270 WRITE (MU,9270)                                                   00226
      RETURN                                                            00227
  271 WRITE (MU,9271)                                                   00228
      RETURN                                                            00229
  272 WRITE (MU,9272)                                                   00230
      RETURN                                                            00231
  273 WRITE (MU,9273)                                                   00232
      RETURN                                                            00233
  274 WRITE (MU,9274)                                                   00234
      RETURN                                                            00235
C                                                                       00236
  301 WRITE (MU,9301)                                                   00237
      RETURN                                                            00238
  302 WRITE (MU,9302)                                                   00239
      RETURN                                                            00240
  303 WRITE (MU,9303)                                                   00241
      RETURN                                                            00242
  304 WRITE (MU,9304)                                                   00243
      RETURN                                                            00244
  305 WRITE (MU,9305)                                                   00245
      RETURN                                                            00246
  306 WRITE (MU,9306)                                                   00247
      RETURN                                                            00248
  307 WRITE (MU,9307)                                                   00249
      RETURN                                                            00250
  308 WRITE (MU,9308)                                                   00251
      RETURN                                                            00252
  309 WRITE (MU,9309)                                                   00253
      RETURN                                                            00254
  321 WRITE (MU,9321)                                                   00255
      RETURN                                                            00256
  322 WRITE (MU,9322)                                                   00257
      RETURN                                                            00258
  323 WRITE (MU,9323)                                                   00259
      RETURN                                                            00260
  324 WRITE (MU,9324)                                                   00261
      RETURN                                                            00262
  325 WRITE (MU,9325)                                                   00263
      RETURN                                                            00264
  326 WRITE (MU,9326)                                                   00265
      RETURN                                                            00266
  327 WRITE (MU,9327)                                                   00267
      RETURN                                                            00268
  328 WRITE (MU,9328)                                                   00269
      RETURN                                                            00270
  329 WRITE (MU,9329)                                                   00271
      RETURN                                                            00272
  330 WRITE (MU,9330)                                                   00273
      RETURN                                                            00274
  331 WRITE (MU,9331)                                                   00275
      RETURN                                                            00276
  332 WRITE (MU,9332)                                                   00277
      RETURN                                                            00278
  333 WRITE (MU,9333)                                                   00279
      RETURN                                                            00280
  334 WRITE (MU,9334)                                                   00281
      RETURN                                                            00282
  335 WRITE (MU,9335)                                                   00283
      RETURN                                                            00284
  336 WRITE (MU,9336)                                                   00285
      RETURN                                                            00286
  337 WRITE (MU,9337)                                                   00287
      RETURN                                                            00288
  338 WRITE (MU,9338)                                                   00289
      RETURN                                                            00290
  351 WRITE (MU,9351)                                                   00291
      RETURN                                                            00292
  352 WRITE (MU,9352)                                                   00293
      RETURN                                                            00294
  353 WRITE (MU,9353)                                                   00295
      RETURN                                                            00296
  354 WRITE (MU,9354)                                                   00297
      RETURN                                                            00298
  355 WRITE (MU,9355)                                                   00299
      RETURN                                                            00300
  356 WRITE (MU,9356)                                                   00301
      RETURN                                                            00302
  357 WRITE (MU,9357)                                                   00303
      RETURN                                                            00304
  358 WRITE (MU,9358)                                                   00305
      RETURN                                                            00306
  359 WRITE (MU,9359)                                                   00307
      RETURN                                                            00308
  360 WRITE (MU,9360)                                                   00309
      RETURN                                                            00310
  361 WRITE (MU,9361)                                                   00311
      RETURN                                                            00312
  362 WRITE (MU,9362)                                                   00313
      RETURN                                                            00314
  363 WRITE (MU,9363)                                                   00315
      RETURN                                                            00316
  364 WRITE (MU,9364)                                                   00317
      RETURN                                                            00318
  365 WRITE (MU,9365)                                                   00319
      RETURN                                                            00320
  366 WRITE (MU,9366)                                                   00321
      RETURN                                                            00322
  367 WRITE (MU,9367)                                                   00323
      RETURN                                                            00324
  368 WRITE (MU,9368)                                                   00325
      RETURN                                                            00326
  369 WRITE (MU,9369)                                                   00327
      RETURN                                                            00328
  370 WRITE (MU,9370)                                                   00329
      RETURN                                                            00330
  371 WRITE (MU,9371)                                                   00331
      RETURN                                                            00332
  372 WRITE (MU,9372)                                                   00333
      RETURN                                                            00334
  373 WRITE (MU,9373)                                                   00335
      RETURN                                                            00336
  374 WRITE (MU,9374)                                                   00337
      RETURN                                                            00338
C                                                                       00339
C                                                                       00340
C*****THE DEFINITIONS*****                                              00341
 1000 FORMAT (1H ,'FOR ONE OF THE VARIABLES NO DEFINITION HAS BEEN SPECI00342
     2FIED IN THE ''DEFINE'' ROUTINE')                                  00343
 9101 FORMAT (1H ,'DATE . . . . REFERENCE DATE (NORMALLY THE LAUNCH DATE00344
     2) (YYMM.DD).')                                                    00345
 9102 FORMAT (1H ,'TIN  . . . . TIME OF INJECTION INTO ORBIT 1, IN HOURS00346
     2 REFERENCED FROM 0 HRS ON REFERENCE DATE. (MAY BE .GT. 24.)')     00347
 9103 FORMAT (1H ,'A1 . . . . . SEMI-MAJOR AXIS, ORBIT 1 (KM).')        00348
 9104 FORMAT (1H ,'E1 . . . . . ECCENTRICITY OF ORBIT 1.')              00349
 9105 FORMAT (1H ,'I1 . . . . . INCLINATION, ORBIT 1 (DEGREES).')       00350
 9106 FORMAT (1H ,'NOD1 . . . . RIGHT ASCENSION OF THE ASCENDING NODE, O00351
     2RBIT 1 (DEGREES).')                                               00352
 9107 FORMAT (1H ,'AOP1 . . . . ARGUMENT OF PERIGEE, ORBIT 1 (DEGREES)')00353
 9108 FORMAT (1H ,'TRUE1. . . . TRUE ANOMALY IN ORBIT 1 OF POINT OF INJE00354
     2CTION INTO ORBIT 1 (DEGREES).')                                   00355
 9109 FORMAT (1H ,'P1 . . . . . PERIOD OF ORBIT 1 (MINUTES).')          00356
 9110 FORMAT (1H ,'ELAPSE . . . NUMBER OF DAYS THAT HAVE ELAPSED SINCE T00357
     2HE FIRST DATE IN THE SCAN.')                                      00358
 9111 FORMAT (1H ,'GMTL . . . . GREENWICH MEAN TIME OF LAUNCH (HRS). (MA00359
     2Y BE .GT. 24.)')                                                  00360
 9151 FORMAT (1H ,'P1IN1. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00361
     2ST ENCOUNTER WITH PENUMBRAL SHADOW ALONG A SPECIFIED SEGMENT OF OR00362
     3BIT 1.')                                                          00363
 9152 FORMAT (1H ,'P1DUR1 . . . DURATION OF FIRST PENUMBRAL SHADOW ENCOU00364
     2NTERED ALONG A SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')          00365
 9153 FORMAT (1H ,'P2IN1. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00366
     2OND ENCOUNTER WITH PENUMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF00367
     3 ORBIT 1.')                                                       00368
 9154 FORMAT (1H ,'P2DUR1 . . . DURATION OF SECOND PENUMBRAL SHADOW ENCO00369
     2UNTERED ALONG THE SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')       00370
 9155 FORMAT (1H ,'PTDUR1 . . . TOTAL PENUMBRAL SHADOW DURATION (FIRST +00371
     2 SECOND) ALONG THE SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')      00372
 9156 FORMAT (1H ,'U1IN1. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00373
     2ST ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF ORB00374
     3IT 1.')                                                           00375
 9157 FORMAT (1H ,'U1DUR1 . . . DURATION OF FIRST UMBRAL SHADOW ENCOUNTE00376
     2RED ALONG THE SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')           00377
 9158 FORMAT (1H ,'U2IN1. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00378
     2OND ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF OR00379
     3BIT 1.')                                                          00380
 9159 FORMAT (1H ,'U2DUR1 . . . DURATION OF SECOND UMBRAL SHADOW ENCOUNT00381
     2ERED ALONG THE SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')          00382
 9160 FORMAT (1H ,'UTDUR1 . . . TOTAL UMBRAL SHADOW DURATION (FIRST + SE00383
     2COND) ALONG THE SPECIFIED SEGMENT OF ORBIT 1 (MINUTES).')         00384
 9161 FORMAT (1H ,'MAXSEP1. . . MAXIMUM EARTH-SATELLITE-SUN SEPARATION A00385
     2NGLE ALONG A SPECIFIED SEGMENT OF ORBIT 1 (DEGREES).')            00386
 9162 FORMAT (1H ,'MINSEP1. . . MINIMUM EARTH-SATELLITE-SUN SEPARATION A00387
     2NGLE ALONG A SPECIFIED SEGMENT OF ORBIT 1 (DEGREES).')            00388
 9163 FORMAT (1H ,'APOSEP1. . . EARTH-SATELLITE-SUN SEPARATION ANGLE AT 00389
     2APOGEE OF ORBIT 1 (DEGREES).')                                    00390
 9164 FORMAT (1H ,'TFPSEP1. . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00391
     2GREES) AT TIME TESSO1 (INPUT IN SECS) AFTER PERIGEE OF ORBIT 1.') 00392
 9165 FORMAT (1H ,'ASP1 . . . . SOLAR ASPECT ANGLE AT INSERTION INTO ORB00393
     2IT 1, ASSUMING SPIN AXIS LIES ALONG SATELLITE VELOCITY VECTOR (DEG00394
     3REES).')                                                          00395
 9166 FORMAT (1H ,'ASPN1. . . . SOLAR ASPECT ANGLE AT INSERTION INTO ORB00396
     2IT 1, ASSUMING SPIN AXIS LIES ALONG NEGATIVE OF SAT. VELOCITY VECT00397
     3OR (DEG).')                                                       00398
C                                                                       00399
 9201 FORMAT (1H ,'DATE2. . . . DATE OF INSERTION INTO ORBIT 2 (YYMM.DD)00400
     2.')                                                               00401
 9202 FORMAT (1H ,'TIN2 . . . . TIME OF INSERTION INTO ORBIT 2 (HRS).') 00402
 9203 FORMAT (1H ,'A2 . . . . . SEMI-MAJOR AXIS, ORBIT 2 (KM).')        00403
 9204 FORMAT (1H ,'E2 . . . . . ECOENTRICITY OF ORBIT 2.')              00404
 9205 FORMAT (1H ,'I2 . . . . . INCLINATION, ORBIT 2 (DEGREES).')       00405
 9206 FORMAT (1H ,'NOD2 . . . . RIGHT ASCENSION OF ASCENDING NODE, ORBIT00406
     2 2 (DEGREES).')                                                   00407
 9207 FORMAT (1H ,'AOP2 . . . . ARGUMENT OF PERIGEE, ORBIT 2 (DEGREES)')00408
 9208 FORMAT (1H ,'TRUE2. . . . TRUE ANOMALY IN ORBIT 2 OF INSERTION POI00409
     2NT INTO ORBIT 2 (DEGREES).')                                      00410
 9209 FORMAT (1H ,'P2 . . . . . PERIOD OF ORBIT 2 (MINUTES).')          00411
 9221 FORMAT (1H ,'PHI1 . . . . IN ORBIT 1, CENTRAL ANGLE BETWEEN INSERT00412
     2ION AND LEAVE POINTS (DEGREES).')                                 00413
 9222 FORMAT (1H ,'RINS2. . . . MAGNITUDE OF POSITION VECTOR OF POINT OF00414
     2 INSERTION INTO ORBIT 2 (KM).')                                   00415
 9223 FORMAT (1H ,'TA12 . . . . TRUE ANOMALY IN ORBIT 1 OF POINT OF INSE00416
     2RTION INTO ORBIT 2 (DEGREES).')                                   00417
 9224 FORMAT (1H ,'STAY1. . . . TIME SATELLITE SPENDS IN ORBIT 1 ALONG A00418
     2RC BETWEEN INSERTION AND LEAVE PTS., NOT INCLUDING ADDITIONAL COMP00419
     3LETE'/'              REVOLUTIONS (MINUTES).')                     00420
 9225 FORMAT (1H ,'VA12 X . . . X COMPONENT, SATELLITE VELOCITY VECTOR I00421
     2N ORBIT 1 IMMEDIATELY BEFORE INSERTION INTO ORBIT 2 (KM/SEC).')   00422
 9226 FORMAT (1H ,'VA12 Y . . . Y COMPONENT, SATGLLITE VELOCITY VECTOR I00423
     2N ORBIT 1 IMMEDIATELY BEFORE INSERTION INTO ORBIT 2 (KM/SEC).')   00424
 9227 FORMAT (1H ,'VA12 Z . . . Z COMPONENT, SATELLITE VELOCITY VECTOR I00425
     2N ORBIT 1 IMMEDIATELY BEFORE INSERTION INTO ORBIT 2 (KM/SEC).')   00426
 9228 FORMAT (1H ,'VB12 X . . . X COMPONENT, SATELLITE VELOCITY VECTOR I00427
     2N ORBIT 2 IMMEDIATELY AFTER  INSERTION INTO ORBIT 2 (KM/SEC).')   00428
 9229 FORMAT (1H ,'VB12 Y . . . Y COMPONENT, SATELLITE VELOCITY VECTOR I00429
     2N ORBIT 2 IMMEDIATELY AFTER  INSERTION INTO ORBIT 2 (KM/SEC).')   00430
 9230 FORMAT (1H ,'VB12 Z . . . Z COMPONENT, SATELLITE VELOCITY VECTOR I00431
     2N ORBIT 2 IMMEDIATELY AFTER  INSERTION INTO ORBIT 2 (KM/SEC).')   00432
 9231 FORMAT (1H ,'DELV12 X . . X COMPONENT OF THE VELOCITY VECTOR OF TH00433
     2E ORBIT 1 TO ORBIT 2 MANEUVER (KM/SEC).')                         00434
 9232 FORMAT (1H ,'DELV12 Y . . Y COMPONENT OF THE VELOCITY VECTOR OF TH00435
     2E ORBIT 1 TO ORBIT 2 MANEUVER (KM/SEC).')                         00436
 9233 FORMAT (1H ,'DELV12 Z . . Z COMPONENT OF THE VELOCITY VECTOR OF TH00437
     2E ORBIT 1 TO ORBIT 2 MANEUVER (KM/SEC).')                         00438
 9234 FORMAT (1H ,'DV2. . . . . MAGNITUDE OF THE VELOCITY VECTOR OF THE 00439
     2ORBIT 1 TO ORBIT 2 MANEUVER (KM/SEC).')                           00440
 9235 FORMAT (1H ,'RA12 . . . . RIGHT ASCENSION OF SATELLITE SPIN AXIS A00441
     2T INSERTION INTO ORBIT 2, ASSUMING SPIN AXIS LIES ALONG'/'        00442
     3      MANEUVER VELOCITY VECTOR (DEGREES).')                       00443
 9236 FORMAT (1H ,'DECL12 . . . DECLINATION OF SATELLITE SPIN AXIS AT IN00444
     ISERTION INTO ORBIT 2, ASSUMING SPIN AXIS LIES ALONG'/'            00445
     3  MANEUVER VELOCITY VECTOR (OEGREES).')                           00446
 9237 FORMAT (1H ,'RA12N. . . . RIGHT ASCENSION OF SATELLITE SPIN AXIS A00447
     2T INSERTION INTO ORBIT 2, ASSUMING SPIN AXIS LIES ALONG'/'        00448
     3      NEGATIVE OF MANEUVER VELOCITY VECTOR (DEGREES).')           00449
 9238 FORMAT (1H ,'DECL12N. . . DECLINATION OF SATELLITE SPIN AXIS AT IN00450
     2SERTION INTO ORBIT 2, ASSUMING SPIN AXIS LIES ALONG'/'            00451
     3  NEGATIVE OF MANEUVER VELOCITY VECTOR (DEGREES).')               00452
 9251 FORMAT (1H ,'P1IN2. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00453
     2ST ENCOUNTER WITH PENUMBRAL SHADOW ALONG A SPECIFIED SEGMENT OF OR00454
     3BIT 2.')                                                          00455
 9252 FORMAT (1H ,'P1DUR2 . . . DURATION OF FIRST PENUMBRAL SHADOW ENCOU00456
     2NTERED ALONG A SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')          00457
 9253 FORMAT (1H ,'P2IN2. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00458
     2OND ENCOUNTER WITH PENUMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF00459
     3 ORBIT 2.')                                                       00460
 9254 FORMAT (1H ,'P2DUR2 . . . DURATION OF SECOND PENUMBRAL SHADOW ENCO00461
     2UNTERED ALONG THE SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')       00462
 9255 FORMAT (1H ,'PTDUR2 . . . TOTAL PENUMBRAL SHADOW DURATION (FIRST +00463
     2 SECOND) ALONG THE SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')      00464
 9256 FORMAT (1H ,'U1IN2. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00465
     2ST ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF ORB00466
     3IT 2.')                                                           00467
 9257 FORMAT (1H ,'U1DUR2 . . . DURATION OF FIRST UMBRAL SHADOW ENCOUNTE00468
     2RED ALONG THE SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')           00469
 9258 FORMAT (1H ,'U2IN2. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00470
     2OND ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF OR00471
     3BIT 2.')                                                          00472
 9259 FORMAT (1H ,'U2DUR2 . . . DURATION OF SECOND UMBRAL SHADOW ENCOUNT00473
     2ERED ALONG THE SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')          00474
 9260 FORMAT (1H ,'UTDUR2 . . . TOTAL UMBRAL SHADOW DURATION (FIRST + SE00475
     2COND) ALONG THE SPECIFIED SEGMENT OF ORBIT 2 (MINUTES).')         00476
 9261 FORMAT (1H ,'MAXSEP2. . . MACIMUM EARTH-SATELLITE-SUN SEPARATION A00477
     2NGLE ALONG A SPECIFIED SEGMENT OF THE LAST REVOLUTION OF ORBIT 2 (00478
     3DEGREES).')                                                       00479
 9262 FORMAT (1H ,'MINSEP2. . . MINIMUM EARTH-SATELLITE-SUN SEPARATION A00480
     2NGLE ALONG A SPECIFIED SEGMENT OF THE LAST REVOLUTION OF ORBIT 2 (00481
     3DEGREES).')                                                       00482
 9263 FORMAT (1H ,'APOSEP2. . . EARTH-SATELLITE-SUN SEPARATION ANGLE AT 00483
     2APOGEE OF THE LAST REVOLUTION OF ORBIT 2 (DEGREES).')             00484
 9264 FORMAT (1H ,'TFPSEP2. . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00485
     3GREES) AT TIME TESSO2 (INPUT IN SECS) AFTER PERIGEE OF THE'/' ',  00486
     4 14X, 'LAST REVOULTION OF ORBIT 2.')                              00487
 9265 FORMAT (1H ,'MXSEP2R1 . . MAXIMUM EARTH-SATELLITE-SUN SEPARATION A00488
     2NGLE ALONG A SPECIFIED SEGMENT OF THE FIRST REVOLUTION OF ORBIT 2 00489
     3(DEGREES).')                                                      00490
 9266 FORMAT (1H ,'MNSEP2R1 . . MINIMUM EARTH-SATELLITE-SUN SEPARATION A00491
     2NGLE ALONG A SPECIFIED SEGMENT OF THE FIRST REVOLUTION OF ORBIT 2 00492
     3(DEGREES).')                                                      00493
 9267 FORMAT (1H ,'APSEP2R1 . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00494
     2GREES) AT APOGEE OF THE FIRST REVOLUTION OF ORBIT 2.')            00495
 9268 FORMAT (1H ,'TPSEP2R1 . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00496
     2GREES) AT TIME TESSO2 (INPUT IN SECS) AFTER PERIGEE OF THE'/' ',  00497
     3 14X, 'FIRST REVOLUTION OF ORBIT 2.')                             00498
 9269 FORMAT (1H ,'ASP2 . . . . SOLAR ASPECT ANGLE AT INSERTION INTO ORB00499
     2IT 2, ASSUMING SPIN AXIS LIES ALONG MANEUVER  VELOCITY VECTOR (DEG00500
     3REES).')                                                          00501
 9270 FORMAT (1H ,'ASP2R1 . . . (DEGREES) VALUE SOLAR ASPECT ANGLE WOULD00502
     2 HAVE AT INSERTION PT. INTO ORBIT 2 WHEN NO FULL REVOLUTIONS IN OR00503
     3BIT 1'/' ',14X, 'ARE INCLUDED (I.E., VALUE FOR A TIME CORRESPONDIN00504
     4G TO KREVS1=0) -- AND WHERE SPIN AXIS IS ASSUMED TO LIE ALONG'/   00505
     5      ' ',14X,'MANEUVER VELOCITY VECTOR.')                        00506
 9271 FORMAT (1H ,'APOGEO2. . . ANGLE (DEGREES) NEAR APOGEE OF ORBIT 2 B00507
     2ETWEEN THE DELTA-V VECTOR, ASSUMED TO LIE ALONG THE SPIN AXIS,'/  00508
     3' ',14X,'AND THE RADIUS VECTOR.')                                 00509
 9272 FORMAT (1H ,'PERGEO2. . . ANGLE (DEGREES) NEAR PERIGEE OF ORBIT 2 00510
     2BETWEEN THE DELTA-V VECTOR, ASSUMED TO LIE ALONG THE SPIN AXIS,'/ 00511
     3' ',14X,'AND THE RADIUS VECTOR.')                                 00512
 9273 FORMAT (1H ,'PCDR12 . . . MINUTES OF CONTIGUOUS PENUMBRAL SHADOW D00513
     2URATION IN ORBITS 1 AND 2.')                                      00514
 9274 FORMAT (1H ,'UCDR12 . . . MINUTES OF CONTIGUOUS UMBRAL SHADOW DURA00515
     2TION IN ORBITS 1 AND 2.')                                         00516
 9301 FORMAT (1H ,'DATE3. . . . DATE OF INSERTION INTO ORBIT 3 (YYMM.DD)00517
     2.')                                                               00518
 9302 FORMAT (1H ,'TIN3 . . . . TIME OF INSERTION INTO ORBIT 3 (HRS).') 00519
 9303 FORMAT (1H ,'A3 . . . . . SEMI-MAJOR AXIS, ORBIT 3 (KM).')        00520
 9304 FORMAT (1H ,'E3 . . . . . ECCENTRICITY OF ORBIT 3.')              00521
 9305 FORMAT (1H ,'I3 . . . . . INCLINATION, ORBIT 3 (DEGREES).')       00522
 9306 FORMAT (1H ,'NOD3 . . . . RIGHT ASCENSION OF ASCENDING NODE, ORBIT00523
     2 3 (DEGREES).')                                                   00524
 9307 FORMAT (1H ,'AOP3 . . . . ARGUMENT OF PERIGEE, ORBIT 3 (DEGREES)')00525
 9308 FORMAT (1H ,'TRUE3. . . . TRUE ANOMALY IN ORBIT 3 OF INSERTION POI00526
     2NT INTO ORBIT 3 (DEGREES).')                                      00527
 9309 FORMAT (1H ,'P3 . . . . . PERIOD OF ORBIT 3 (MINUTES).')          00528
 9321 FORMAT (1H ,'PHI2 . . . . IN ORBIT 2, CENTRAL ANGLE BETWEEN INSERT00529
     2ION AND LEAVE POINTS (DEGREES).')                                 00530
 9322 FORMAT (1H ,'RINS3. . . . MAGNITUDE OF POSITION VECTOR OF POINT OF00531
     2 INSERTION INTO ORBIT 3 (KM).')                                   00532
 9323 FORMAT (1H ,'TA23 . . . . TRUE ANOMALY IN ORBIT 2 OF POINT OF INSE00533
     2RTION INTO ORBIT 3 (DEGREES).')                                   00534
 9324 FORMAT (1H ,'STAY2. . . . TIME SATELLITE SPENDS IN ORBIT 2 ALONG A00535
     2RC BETWEEN INSERTION AND LEAVE PTS., NOT INCLUDING ADDITIONAL COMP00536
     3LETE'/'              REVOLUTIONS (MINUTES).')                     00537
 9325 FORMAT (1H ,'VA23 X . . . X COMPONENT, SATELLITE VELOCITY VECTOR I00538
     2N ORBIT 2 IMMEDIATELY BEFORE INSERTION INTO ORBIT 3 (KM/SEC).')   00539
 9326 FORMAT (1H ,'VA23 Y . . . Y COMPONENT, SATELLITE VELOCITY VECTOR I00540
     2N ORBIT 2 IMMEDIATELY BEFORE INSERTION INTO ORBIT 3 (KM/SEC).')   00541
 9327 FORMAT (1H ,'VA23 Z . . . Z COMPONENT, SATELLITE VELOCITY VECTOR I00542
     2N ORBIT 2 IMMEDIATELY BEFORE INSERTION INTO ORBIT 3 (KM/SEC).')   00543
 9328 FORMAT (1H ,'VB23 X . . . X COMPONENT, SATELLITE VELOCITY VECTOR I00544
     2N ORBIT 3 IMMEDIATELY AFTER  INSERTION INTO ORBIT 3 (KM/SEC).')   00545
 9329 FORMAT (1H ,'VB23 Y . . . Y COMPONENT, SATELLITE VELOCITY VECTOR I00546
     2N ORBIT 3 IMMEDIATELY AFTER  INSERTION INTO ORBIT 3 (KM/SEC).')   00547
 9330 FORMAT (1H ,'VB23 Z . . . Z COMPONENT, SATELLITE VELOCITY VECTOR I00548
     2N ORBIT 3 IMMEDIATELY AFTER  INSERTION INTO ORBIT 3 (KM/SEC).')   00549
 9331 FORMAT (1H ,'DELV23 X . . X COMPONENT OF THE VELOCITY VECTOR OF TH00550
     2E ORBIT 2 TO ORBIT 3 MANEUVER (KM/SEC).')                         00551
 9332 FORMAT (1H ,'DELV23 Y . . Y COMPONENT OF THE VELOCITY VECTOR OF TH00552
     2E ORBIT 2 TO ORBIT 3 MANEUVER (KM/SEC).')                         00553
 9333 FORMAT (1H ,'DELV23 Z . . Z COMPONENT OF THE VELOCITY VECTOR OF TH00554
     2E ORBIT 2 TO ORBIT 3 MANEUVER (KM/SEC).')                         00555
 9334 FORMAT (1H ,'DV3. . . . . MAGNITUDE OF THE VELOCITY VECTOR OF THE 00556
     2ORBIT 2 TO ORBIT 3 MANEUVER (KM/SEC).')                           00557
 9335 FORMAT (1H ,'RA23 . . . . RIGHT ASCENSION OF SATELLITE SPIN AXIS A00558
     2T INSERTION INTO ORBIT 3, ASSUMING SPIN AXIS LIES ALONG'/'        00559
     3      MANEUVER VELOCITY VECTOR (DEGREES).')                       00560
 9336 FORMAT (1H ,'DECL23 . . . DECLINATION OF SATELLITE SPIN AXIS AT IN00561
     2SERTION INTO ORBIT 3, ASSUMING SPIN AXIS LIES ALONG'/'            00562
     3  MANEUVER VELOCITY VECTOR (DEGREES).')                           00563
 9337 FORMAT (1H ,'RA23N. . . . RIGHT ASCENSION OF SATELLITE SPIN AXIS A00564
     2T INSERTION INTO ORBIT 3, ASSUMING SPIN AXIS LIES ALONG'/'        00565
     3      NEGATIVE OF MANEUVER VELOCITY VECTOR (DEGREES).')           00566
 9338 FORMAT (1H ,'DECL23N. . . DECLINATION OF SATELLITE SPIN AXIS AT IN00567
     2SERTION INTO ORBIT 3, ASSUMING SPIN AXIS LIES ALONG'/'            00568
     3  NEGATIVE OF MANEUVER VELOCITY VECTOR (DEGREES).')               00569
 9351 FORMAT (1H ,'P1IN3. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00570
     2ST ENCOUNTER WITH PENUMBRAL SHADOW ALONG A SPECIFIED SEGMENT OF OR00571
     3BIT 3.')                                                          00572
 9352 FORMAT (1H ,'P1DUR3 . . . DURATION OF FIRST PENUMBRAL SHADOW ENCOU00573
     2NTERED ALONG A SPECIFIED SEGMENT OF ORBIT 3 (MINUTES).')          00574
 9353 FORMAT (1H ,'P2IN3. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00575
     2OND ENCOUNTER WITH PENUMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF00576
     3 ORBIT 3.')                                                       00577
 9354 FORMAT (1H ,'P2DUR3 . . . DURATION OF SECOND PENUMBRAL SHADOW ENCO00578
     2UNTERED ALONG THE SPECIFIED SEGMENT OF ORBIT 3 (NINUTES).')       00579
 9355 FORMAT (1H ,'PTDUR3 . . . TOTAL PENUMBRAL SHADOW DURATION (FIRST +00580
     2 SECOND) ALONG THE SPECIFIED SEGMENT OF ORBIT 3 (MINUTES).')      00581
 9356 FORMAT (1H ,'U1IN3. . . . TIME (IN MINUTES SINCE INSERTION) OF FIR00582
     2ST ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF ORB00583
     3IT 3.')                                                           00584
 9357 FORMAT (1H ,'U1DUR3 . . . DURATION OF FIRST UMBRAL SHADOW ENCOUNTE00585
     2RED ALONG THE SPECIFIED SEGMENT OF ORBIT 3 (MINUTES).')           00586
 9358 FORMAT (1H ,'U2IN3. . . . TIME (IN MINUTES SINCE INSERTION) OF SEC00587
     2OND ENCOUNTER WITH UMBRAL SHADOW ALONG THE SPECIFIED SEGMENT OF OR00588
     3BIT 3.')                                                          00589
 9359 FORMAT (1H ,'U2DUR3 . . . DURATION OF SECOND UMBRAL SHADOW ENCOUNT00590
     2ERED ALONG THE SPECIFIED SEGMENT OF ORBIT 3 (MINUTES).')          00591
 9360 FORMAT (1H ,'UTDUR3 . . . TOTAL UMBRAL SHADOW DURATION (FIRST + SE00592
     2COND) ALONG THE SPECIFIED SEGMENT OF ORBIT 3 (MINUTES).')         00593
 9361 FORMAT (1H ,'MAXSEP3. . . MAXIMUM EARTH-SATELLITE-SUN SEPARATION A00594
     2NGLE ALONG A SPECIFIED SEGMENT OF THE LAST REVOLUTION OF ORBIT 3 (00595
     3DEGREES).')                                                       00596
 9362 FORMAT (1H ,'MINSEP3. . . MINIMUM EARTH-SATELLITE-SUN SEPARATION A00597
     2NGLE ALONG A SPECIFIED SEGMENT OF THE LAST REVOLUTION OF ORBIT 3 (00598
     3DEGREES).')                                                       00599
 9363 FORMAT (1H ,'APOSEP3. . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00600
     2GREES) AT APOGEE OF THE LAST REVOLUTION OF ORBIT 3.')             00601
 9364 FORMAT (1H ,'TFPSEP3. . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00602
     2GREES) AT TIME TESSO3 (INPUT IN SECS) AFTER PERIGEE OF THE'/' ',  00603
     3 14X, 'LAST REVOLUTION OF ORBIT 3.')                              00604
 9365 FORMAT (1H ,'MXSEP3R1 . . MAXIMUM EARTH-SATELLITE-SUN SEPARATION A00605
     2NGLE ALONG A SPECIFIED SEGMENT OF THE FIRST REVOLUTION OF ORBIT 3 00606
     3(DEGREES).')                                                      00607
 9366 FORMAT (1H ,'MNSEP3R1 . . MINIMUM EARTH-SATELLITE-SUN SEPARATION A00608
     2NGLE ALONG A SPECIFIED SEGMENT OF THE FIRST REVOLUTION OF ORBIT 3 00609
     3(DEGREES).')                                                      00610
 9367 FORMAT (1H ,'APSEP3R1 . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00611
     2GREES) AT APOGEE OF THE FIRST REVOLUTION OF ORBIT 3.')            00612
 9368 FORMAT (1H ,'TPSEP3R1 . . EARTH-SATELLITE-SUN SEPARATION ANGLE (DE00613
     2GREES) AT TIME TESSO3 (INPUT IN SECS) AFTER PERIGEE OF THE'/' ',  00614
     3 14X, 'FIRST REVOLUTION OF ORBIT 3.')                             00615
 9369 FORMAT (1H ,'ASP3 . . . . SOLAR ASPECT ANGLE AT INSERTION INTO ORB00616
     2IT 3, ASSUMING SPIN AXIS LIES ALONG MANEUVER VELOCITY VECTOR (DEGR00617
     3EES).')                                                           00618
 9370 FORMAT (1H ,'ASPN3. . . . SOLAR ASPECT ANGLE AT INSERTION INTO ORB00619
     2IT 3, ASSUMING SPIN AXIS LIES ALONG NEGATIVE OF MANEUVER VELOCITY 00620
     3VECTOR (DEG).')                                                   00621
 9371 FORMAT (1H ,'ASP3R1 . . . (DEGREES) VALUE SOLAR ASPECT ANGLE WOULD00622
     2 HAVE AT INSERTION PT. INTO ORBIT 3 WHEN NO FULL REVOLUTIONS IN OR00623
     3BIT 2'/' ',14X, 'ARE INCLUDED (I.E.,VALUE FOR A TIME CORRESPONDING00624
     4 TO KREVS2=0) -- AND WHERE SPIN AXIS IS ASSUMED TO LIE ALONG'/' ',00625
     5  14X, 'MANEUVER VELOCITY VECTOR.')                               00626
 9372 FORMAT (1H ,'ASPN3R1. . . (DEGREES) VALUE SOLAR ASPECT ANGLE WOULD00627
     2 HAVE AT INSERTION PT. INTO ORBIT 3 WHEN NO FULL REVOLUTIONS IN OR00628
     3BIT 2'/' ',14X, 'ARE INCLUDED (I.E., VALUE FOR A TIME CORRESPONDIN00629
     4G TO KREVS2=0) -- AND WHERE SPIN AXIS IS ASSUMED TO LIE ALONG'/   00630
     5      ' ',14X,'NEGATIVE OF MANEUVER VELOCITY VECTOR.')            00631
 9373 FORMAT (1H ,'ASP3DEP. . . ANGLE (DEGREES) BETWEEN SUN POSITION VEC00632
     2TOR AND INSTANTANEOUS VELOCITY VECTOR OF SATELLITE IN ORBIT 3'/' '00633
     3,14X, 'IMMEDIATELY BEFORE DEPARTURE FROM ORBIT 3.')               00634
 9374 FORMAT (1H ,'ASPN3DEP . . ANGLE (DEGREES) BETWEEN SUN POSITION VEC00635
     2TOR AND NEGATIVE OF INSTANTANEOUS VELOCITY VECTOR OF SATELLITE IN 00636
     3ORBIT 3'/' ',14X, 'IMMEDIATELY BEFORE DEPARTURE FROM ORBIT 3.')   00637
      END                                                               00638
C          DATA SET DEGRAD     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE DEGRAD (KONVRT,DEG1,DEG2,DEG3,DEG4,RAD1,RAD2,RAD3,RAD4)00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE DEGRAD (KONVRT,DEG1,DEG2,DEG3,DEG4,RAD1,RAD2,RAD3,RAD4)00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF DEGRAD IS TO CONVERT UP TO 4 ANGLES FROM DEGREES TO00000100
C         RADIANS OR FROM RADIANS TO DEGREES.                           00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/0        DEFINITION                      00000170
C                                                                       00000180
C          KONVRT    I*4      I      CONVERSION FLAG--                  00000190
C                                      .EQ.0, CONVERT FROM RADIANS TO   00000200
C                                         DEGREES                       00000210
C                                      .NE.0, CONVERT FROM DEGREES TO   00000220
C                                         RADIANS                       00000230
C          DEG1      R*8     I/O     FIRST ANGLE (DEG)                  00000240
C          DEG2      R*8     I/O     SECOND ANGLE (DEG)                 00000250
C          DEG3      R*8     I/O     THIRD ANGLE (DEG)                  00000260
C          DEG4      R*8     I/O     FOURTH ANGLE (DEG)                 00000270
C          RAD1      R*8     I/O     FIRST ANGLE (RAD)                  00000280
C          RAD2      R*8     I/O     SECOND ANGLE (RAD)                 00000290
C          RAD3      R*8     I/O     THIRD ANGLE (RAD)                  00000300
C          RAD4      R*8     I/O     FOURTH ANGLE (RAD)                 00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     DEGRAD IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000350
C                                                                       00000360
C         ESSO                                                          00000370
C         INPUT ROUTINES                                                00000380
C         MODE DRIVER ROUTINES                                          00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C     NO SUBROUTINES ARE CALLED BY DEGRAD.                              00000430
C                                                                       00000440
C                                                                       00000450
C                                                                       00000460
C     DEGRAD NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000470
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000480
C                                                                       00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
      DR = 0.017453292519943D0                                          00000540
      IF (KONVRT .EQ. 0) GO TO 100                                      00000550
      RAD1 = DEG1 * DR                                                  00000560
      RAD2 = DEG2 * DR                                                  00000570
      RAD3 = DEG3 * DR                                                  00000580
      RAD4 = DEG4 * DR                                                  00000590
      RETURN                                                            00000600
  100 DEG1 = RAD1 / DR                                                  00000610
      DEG2 = RAD2 / DR                                                  00000620
      DEG3 = RAD3 / DR                                                  00000630
      DEG4 = RAD4 / DR                                                  00000640
      RETURN                                                            00000650
      END                                                               00000660
C          DATA SET DFALT1     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE DFALT1                                                 00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000030
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000040
      COMMON/SCANS/TLINJ,DUMMY(8),JDUMMY,JSCAN                          00000050
      COMMON/ONECAN/      TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1      00000060
      DO 5 K=1,7                                                        00000070
      M(K)  = 0                                                         00000080
      DO 5 J=1,11                                                       00000090
    5 OUT(J,K) = 0.D0                                                   00000100
      M(1) = 6                                                          00000110
      MORB  = 0                                                         00000120
      MOFLAG=0                                                          00000130
      MSUN  = 0                                                         00000140
      MPLOT = 0                                                         00000150
      MDISK = 0                                                         00000160
      JSCAN = 2                                                         00000170
      TLINJ = 0.D0                                                      00000180
      DO 10 K=1,20                                                      00000190
   10 KCAN1(K) = 0                                                      00000200
      TESSO1  = 0.D0                                                    00000210
      ARC1    = 0.D0                                                    00000220
      KREVS1  = 0                                                       00000230
      JUMB1   =1                                                        00000240
      JPEN1   = 1                                                       00000250
      RETURN                                                            00000260
      END                                                               00000270
C          DATA SET DFALT2     AT LEVEL 001 AS OF 11/07/78              00000000
      SUBROUTINE DFALT2                                                 00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
      REAL*8 NOD2                                                       00000030
      COMMON/DGREE2/ NOD2,DN2MAX,TH2,B2,TRUE1                           00000040
      COMMON/TWO/ A2,DV2,XINC2,XNODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000050
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000060
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000070
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000080
      COMMON/SCANS/TLINJ,DUMMY(8),JDUMMY,JSCAN                          00000090
      COMMON/ONECAN/      TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1      00000100
      COMMON/TWOCAN/      TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2      00000110
      DO 5 K=1,7                                                        00000120
      M(K)  = 0                                                         00000130
      DO 5 J=1,11                                                       00000140
    5 OUT(J,K) = 0.D0                                                   00000150
      M(1) = 6                                                          00000160
      MORB  = 0                                                         00000170
      MOFLAG=0                                                          00000180
      MSUN  = 0                                                         00000190
      MPLOT = 0                                                         00000200
      MDISK = 0                                                         00000210
      JSCAN = 2                                                         00000220
      TLINJ = 0.D0                                                      00000230
      DO 10 K=1,20                                                      00000240
      KCAN1(K) = 0                                                      00000250
   10 KCAN2(K) = 0                                                      00000260
      TESSO1  = 0.D0                                                    00000270
      TESSO2  = 0.D0                                                    00000280
      ARC1    = 0.D0                                                    00000290
      ARC2 = 1.D0                                                       00000300
      KREVS1  = 0                                                       00000310
      KREVS2  = 0                                                       00000320
      JUMB1   =1                                                        00000330
      JUMB2   =1                                                        00000340
      JPEN1   = 1                                                       00000350
      JPEN2   = 1                                                       00000360
      JNOD2    = 1                                                      00000370
      NOD2     = 0.D0                                                   00000380
      ARGPI2=-10.D0                                                     00000390
      DN2MAX   = 0.D0                                                   00000400
      JGIDE2   = 2                                                      00000410
      JINS2    =+1                                                      00000420
      TH2 = 0.0                                                         00000430
      B2 = 0.0                                                          00000440
      TRUE1 = 0.0                                                       00000450
      JREL3=0                                                           00000455
      RETURN                                                            00000460
      END                                                               00000470
C          DATA SET DFALT3     AT LEVEL 001 AS OF 11/07/78              00000000
      SUBROUTINE DFALT3                                                 00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE DFALT3                                                 00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF DFALT3 IS TO SET THE DEFAULT VALUES OF THE NAMELIST00000090
C         INPUT PARAMETERS FOR MODE=3.                                  00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL INPUT AND     00000140
C         OUTPUT VARIABLES ARE PASSED THROUGH COMMON.                   00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     DFALT3 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000190
C                                                                       00000200
C         MAIN                                                          00000210
C                                                                       00000220
C                                                                       00000230
C                                                                       00000240
C     NO SUBROUTINES ARE CALLED BY DFALT3.                              00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000290
C                                                                       00000300
C         COMMON VARIABLES COMPUTED                                     00000310
C                                                                       00000320
C         ARC1      JG1DE3    JPEN3     KCAN2(20) MDISK     NOD3        00000330
C         ARC2      JINS2     JSCAN     KCAN3(20) MOFLAG    OUT(11,7)   00000340
C         ARC3      JINS3     JUMB1     KREVS1    MORB      TESSO1      00000350
C         DN2MAX    JNOD2     JUMB2     KREVS2    MPLOT     TESSO2      00000360
C         DN3MAX    JNOD3     JUMB3     KREVS3    MSUN      TESSO3      00000370
C         FRAC3     JPEN1     KCAN1(20) M(7)      NOD2      TLINJ       00000380
C         JGIDE2    JPEN2                                               00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C****************************  W A R N I N G  **************************00000440
C  **                                                               **  00000450
C  **     BECAUSE ALL ANGLES IN THE USUAL COMMON BLOCKS ARE IN      **  00000460
C  **     RADIANS (WHILE THE ANGLES IN THE NAMELIST INPUT ARE IN    **  00000470
C  **     DEGREES), A SPECIAL COMMON BLOCK WHICH IS SHARED ONLY     **  00000480
C  **     WITH SUBROUTINE INPUT3 HAS BEEN ESTABLISHED. ALL AN-      **  00000490
C  **     GLES WHICH ARE TO HAVE DEFAULT VALUES MUST APPEAR IN      **  00000500
C  **     THE NAMELIST /ORB/ OF THE INPUT3 ROUTINE, AND IN THIS     **  00000510
C  **     COMMON BLOCK, /DGREE3/, AND THE DEFAULT VALUES MUST BE    **  00000520
C  **     IN DEGREES.                                               **  00000530
C  **                                                               **  00000540
C***********************************************************************00000550
C                                                                       00000560
C                                                                       00000570
      REAL*8 NOD2,NOD3                                                  00000580
      COMMON/DGREE3/ NOD2,DN2MAX,NOD3,DN3MAX,TH2,B2,TRUE1,TH3,B3,TRUE2  00000590
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000600
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000610
      COMMON/SCANS/TLINJ,DUMMY(8),JDUMMY,JSCAN                          00000620
      COMMON/TWO/ A2,DV2,XINC2,XNODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000630
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000640
      COMMON/THREE/ A3,DV3,XINC3,XNODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00000650
     *              JGIDE3,JNOD3,JINS3                                  00000660
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000670
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2            00000680
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3(20),KREVS3,JUMB3,JPEN3      00000690
C     DEFAULTS FOR OUTPUT FLAGS.                                        00000700
      DO 5 K = 1,7                                                      00000710
      M(K) = 0                                                          00000720
      DO 5 J = 1,11                                                     00000730
    5 OUT(J,K) = 0.D0                                                   00000740
      M(1) = 6                                                          00000750
      MORB = 0                                                          00000760
      MOFLAG= 0                                                         00000770
      MSUN  = 0                                                         00000780
      MPLOT=0                                                           00000790
      MDISK = 0                                                         00000800
C     FLAGS FOR CHOOSING CONSTRAINED-PARAMETER ANALYSES.                00000810
      DO 10 K  = 1,20                                                   00000820
      KCAN1(K) = 0                                                      00000830
      KCAN2(K) = 0                                                      00000840
   10 KCAN3(K) = 0                                                      00000850
C     OTHER DEFAULT VALUES.                                             00000860
      JSCAN    = 2                                                      00000870
      TLINJ    = 0.D0                                                   00000880
      JNOD2    = 1                                                      00000890
      NOD2     = 0.D0                                                   00000900
      ARGPI2=-10.D0                                                     00000910
      DN2MAX   = 0.D0                                                   00000920
      JGIDE2   = 2                                                      00000930
      JINS2    = +1                                                     00000940
      TH2 = 0.0                                                         00000950
      B2 = 0.0                                                          00000960
      TRUE1 = 0.0                                                       00000970
      JNOD3    = 1                                                      00000980
      NOD3     = 0.D0                                                   00000990
      ARGPI3=-10.D0                                                     00001000
      DN3MAX   = 0.D0                                                   00001010
      JGIDE3   = 1                                                      00001020
      JINS3    = -1                                                     00001030
      TH3 = 0.0                                                         00001040
      B3 = 0.0                                                          00001050
      TRUE2 = 0.0                                                       00001060
      TESSO1   = 0.D0                                                   00001070
      ARC1     = 0.D0                                                   00001080
      KREVS1   = 0                                                      00001090
      JUMB1    = 1                                                      00001100
      JPEN1    = 1                                                      00001110
      TESSO2   = 0.D0                                                   00001120
      ARC2     = 1.D0                                                   00001130
      KREVS2   = 0                                                      00001140
      JUMB2    = 1                                                      00001150
      JPEN2    = 1                                                      00001160
      FRAC3    = 1.D0                                                   00001170
      TESSO3   = 0.D0                                                   00001180
      ARC3     = 1.D0                                                   00001190
      KREVS3   = 0                                                      00001200
      JUMB3    = 1                                                      00001210
      JPEN3    = 1                                                      00001220
      JREL3=0                                                           00001225
      RETURN                                                            00001230
      END                                                               00001240
C          DATA SET DFALT4     AT LEVEL 001 AS OF 11/07/78              00000000
      SUBROUTINE DFALT4                                                 00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
      REAL*8 NOD2,NOD3                                                  00000030
      COMMON/DGREE3/ NOD2,DN2MAX,NOD3,DN3MAX,TH2,B2,TRUE1,TH3,B3,TRUE2  00000040
      COMMON/TWO/ A2,DV2,XINC2,XNODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000050
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000060
      COMMON/THREE/ A3,DV3,XINC3,XNODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00000070
     *              JGIDE3,JNOD3,JINS3                                  00000080
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000090
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000100
      COMMON/SCANS/TLINJ,DUMMY(8),JDUMMY,JSCAN                          00000110
      COMMON/ONECAN/      TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1      00000120
      COMMON/TWOCAN/      TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2      00000130
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3(20),KREVS3,JUMB3,JPEN3      00000140
      COMMON/FOURCA/FRAC4,TESSO4,ARC4,KCAN4(20),KREVS4,JUMB4,JPEN4      00000150
      DO 5 K=1,7                                                        00000160
      M(K)  = 0                                                         00000170
      DO 5 J=1,11                                                       00000180
    5 OUT(J,K) = 0.D0                                                   00000190
      M(1) = 6                                                          00000200
      MORB  = 0                                                         00000210
      MOFLAG=0                                                          00000220
      MSUN  = 0                                                         00000230
      MPLOT = 0                                                         00000240
      MDISK = 0                                                         00000250
      JSCAN = 2                                                         00000260
      TLINJ = 0.D0                                                      00000270
      DO 10 K=1,20                                                      00000280
      KCAN1(K) = 0                                                      00000290
      KCAN2(K) = 0                                                      00000300
      KCAN3(K) = 0                                                      00000310
   10 KCAN4(K) = 0                                                      00000320
      TESSO1  = 0.D0                                                    00000330
      TESSO2  = 0.D0                                                    00000340
      TESSO3  = 0.D0                                                    00000350
      TESSO4  = 0.D0                                                    00000360
      ARC1    = 0.D0                                                    00000370
      ARC2 = 1.D0                                                       00000380
      ARC3 = 1.D0                                                       00000390
      ARC4 = 1.D0                                                       00000400
      FRAC3 = 1.0                                                       00000410
      FRAC4 = 1.0                                                       00000420
      KREVS1  = 0                                                       00000430
      KREVS2  = 0                                                       00000440
      KREVS3  = 0                                                       00000450
      KREVS4  = 0                                                       00000460
      JUMB1   =1                                                        00000470
      JUMB2   =1                                                        00000480
      JUMB3 = 1                                                         00000490
      JUMB4 = 1                                                         00000500
      JPEN1   = 1                                                       00000510
      JPEN2   = 1                                                       00000520
      JPEN3   = 1                                                       00000530
      JPEN4   = 1                                                       00000540
      JNOD2    = 1                                                      00000550
      NOD2     = 0.D0                                                   00000560
      ARGPI2=-10.D0                                                     00000570
      DN2MAX   = 0.D0                                                   00000580
      JGIDE2   = 2                                                      00000590
      JINS2    =+1                                                      00000600
      TH2 = 0.0                                                         00000610
      B2 = 0.0                                                          00000620
      TRUE1 = 0.0                                                       00000630
      JNOD3    = 1                                                      00000640
      NOD3     = 0.D0                                                   00000650
      ARGPI3=-10.D0                                                     00000660
      DN3MAX   = 0.D0                                                   00000670
      JGIDE3   = 1                                                      00000680
      TH3 = 0.0                                                         00000690
      B3 = 0.0                                                          00000700
      TRUE2 = 0.0                                                       00000710
      JINS3    =-1                                                      00000720
      JREL3=0                                                           00000725
      RETURN                                                            00000730
      END                                                               00000740
C          DATA SET DFALT5     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE DFALT5                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE DFALT5                                                 00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF DFALT5 IS TO SET THE DEFALT VALUES OF THE NAMELIST 00000090
C         INPUT PARAMETERS FOR MODE=5.                                  00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL INPUT AND     00000140
C         OUTPUT VARIABLES ARE PASSED THROUGH COMMON.                   00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     DFALT5 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000190
C                                                                       00000200
C         MAIN                                                          00000210
C                                                                       00000220
C                                                                       00000230
C                                                                       00000240
C     NO SUBROUTINES ARE CALLED BY DFALT5.                              00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000290
C                                                                       00000300
C         COMMON VARIABLES COMPUTED                                     00000310
C                                                                       00000320
C         ARC1      JUMB1     KREVS1    MDISK     MPLOT     OUT(11,7)   00000330
C         JPEN1     KCAN1(20) M(7)      MORB      MSUN      TESSO1      00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000380
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000390
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000400
C     DEFAULTS FOR OUTPUT FLAGS.                                        00000410
      DO 5  K = 1,7                                                     00000420
      M(K)    = 0                                                       00000430
      DO 5  J = 1,11                                                    00000440
    5 OUT(J,K)= 0.D0                                                    00000450
      M(1)    = 6                                                       00000460
      MSUN    = 0                                                       00000470
      MORB    = 0                                                       00000480
      MOFLAG  = 0                                                       00000490
      MPLOT   = 0                                                       00000500
      MDISK = 0                                                         00000510
C     OTHER DEFAULTS.                                                   00000520
      TESSO1  = 0.D0                                                    00000530
      ARC1    = 0.D0                                                    00000540
      DO 10 K  = 1,20                                                   00000550
   10 KCAN1(K) = 0                                                      00000560
      KREVS1  = 0                                                       00000570
      JUMB1   = 1                                                       00000580
      JPEN1   = 1                                                       00000590
      RETURN                                                            00000600
      END                                                               00000610
C          DATA SET DOT        AT LEVEL 001 AS OF 11/07/78
      DOUBLE PRECISION FUNCTION DOT(A,B)                                00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     REAL FUNCTION DOT*8(A,B)                                          00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF FUNCTION DOT IS TO COMPUTE THE DOT PRODUCT OF TWO  00000090
C         VECTORS.                                                      00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     INPUT/OUTPUT VARIABLES ARE DEFINED AS FOLLOWS.                    00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C         A(3),B(3)  R*8      I      TWO VECTORS                        00000180
C         DOT(A,B)   R*8      O      DOT PRODUCT                        00000190
C                                                                       00000200
C                                                                       00000210
C                                                                       00000220
C     DOT IS CALLED BY THE FOLLOWING SUBROUTINES.                       00000230
C                                                                       00000240
C          ARCO      ARGROT    DVEL      GEOM      SEP       VERTEX     00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     NO SUBROUTINES ARE CALLED BY DOT.                                 00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     DOT NEITHER USES NOR ALTERS VARIABLES IN COMMON.                  00000330
C         ALL INPUT AND OUTPUT IS THROUGH THE FUNCTION STATEMENT.       00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
      DIMENSION A(3),B(3)                                               00000380
      DOT=A(1)*B(1)+A(2)*B(2)+A(3)*B(3)                                 00000390
      RETURN                                                            00000400
      END                                                               00000410
C          DATA SET DRILL      AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE DRILL (NDXU,NDXP,KCAN,TARC,JJPEN,JJUMB,PEN,UMB)        00000010
C                                                                       00000020
C                                                                       00000030
C     SUBROUTINE DRILL (NDXU,NDXP,KCAN,TARC,JJPEN,JJUMB,PEN,UMB)        00000040
C                                                                       00000050
C                                                                       00000060
C                                                                       00000070
C     THE PURPOSE OF DRILL IS TO DETERMINE WHETHER THE END OF A SEGMENT 00000080
C          OF ARC IS IN SHADOW.                                         00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000130
C                                                                       00000140
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000150
C                                                                       00000160
C          NDXU      I*4      O      INDEX TO LOCATE UMBRAL SHADOW TIME 00000170
C                                       WHEN THE END OF A SEGMENT OF ARC00000180
C                                       IS IN SHADOW                    00000190
C          NDXP      I*4      O      INDEX TO LOCATE PENUMBRAL SHADOW   00000200
C                                       TIME WHEN THE END OF A SEGMENT  00000210
C                                       OF ARC IS IN SHADOW.            00000220
C          KCAN(20)  I*4      I      ARRAY OF 20 FLAGS SIGNALLING WHICH 00000230
C                                       CONSTRAINT ANALYSES ARE TO BE   00000240
C                                       DONE. EACH FLAG IS SET EITHER TO00000250
C                                       ZERO (NO ANALYSIS OF THIS       00000260
C                                       CONSTRAINT) OR 1 (CARR OUT      00000270
C                                       ANALYSIS). ONLY ONE FLAG IS USED00000280
C                                       IN THIS SUBROUTINE --           00000290
C              (1)                      =1, PERFORM SHADOW ANALYSIS     00000300
C                                       =0, NO SHADOW ANALYSIS          00000310
C          TARC      R*8      I      TIME (MINUTES) TO TRAVERSE ORBIT   00000320
C                                       SEGMENT FOR WHICH SHADOW IS     00000330
C                                       INFORMATION IS DESIRED.         00000340
C          JJPEN     I*4      I      =0, DO NOT PERFORM PENUMBRAL       00000350
C                                       ANALYSIS                        00000360
C                                    =1, PERFORM PENUMBRAL ANALYSIS     00000370
C          JJUMB     I*4      I      =0, DO NOT PERFORM UMBRAL ANALYSIS 00000380
C                                    =1, PERFORM UMBRAL ANALYSIS        00000390
C          PEN(5)    R*8      I      PENUMBRAL SHADOW INCIDENCES AND    00000400
C                                       DURATIONS --                    00000410
C           (1)                         FIRST INCIDENCE OF SHADOW ALONG 00000420
C                                          ARC  (MINUTES FROM MEAN      00000430
C                                          ANOMALY AT INSERTION)        00000440
C           (2)                         DURATION OF FIRST SHADOW ALONG  00000450
C                                          ARC (MINUTES)                00000460
C           (3)                         SECOND INCIDENCE OF SHADOW ALONG00000470
C                                          ARC (MINUTES FROM MEAN       00000480
C                                          ANOMALY)                     00000490
C           (4)                         DURATION OF SECOND SHADOW ALONG 00000500
C                                          ARC (MINUTES)                00000510
C           (5)                         TOTAL SHADOW DURATION (FIRST    00000520
C                                          PLUS SECOND DURATION) ALONG  00000530
C                                          ARC (MINUTES)                00000540
C          UMB(5)    R*8      I      UMBRAL SHADOW INCIDENCES AND       00000550
C                                       DURATIONS --                    00000560
C           (1-5)                       SAME DEFINITIONS AS THE VARIABLE00000570
C                                          PEN                          00000580
C                                                                       00000590
C                                                                       00000600
C                                                                       00000610
C     DRILL IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000620
C         LAUCON                                                        00000630
C                                                                       00000640
C                                                                       00000650
C                                                                       00000660
C     DRILL CALLS NO SUBROUTINES.                                       00000670
C                                                                       00000680
C                                                                       00000690
C                                                                       00000700
C     DRILL NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000710
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000720
C                                                                       00000730
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000740
      DIMENSION KCAN(20), PEN(5), UMB(5)                                00000750
      IF (KCAN(1)-1) 10,15,10                                           00000760
   15 IF (JJPEN) 30,35,30                                               00000770
   30 IF (PEN(1)+PEN(2)-TARC+1.D-4) 25,20,20                            00000780
   20 NDXP=52                                                           00000790
      GO TO 35                                                          00000800
   25 IF (PEN(3)+PEN(4)-TARC+1.D-4) 35,45,45                            00000810
   45 NDXP=54                                                           00000820
   35 IF (JJUMP) 40,10,40                                               00000830
   40 IF (UMB(1)+UMB(2)-TARC+1.D-4) 55,50,50                            00000840
   50 NDXU=57                                                           00000850
      GO TO 10                                                          00000860
   55 IF (UMB(3)+UMB(4)-TARC+1.D-4) 10,60,60                            00000870
   60 NDXU=59                                                           00000880
   10 RETURN                                                            00000890
      END                                                               00000900
C          DATA SET DVEL       AT LEVEL 002 AS OF 01/12/79
      SUBROUTINE DVEL (JGIDE,AB,DVMAG,DELTAV,RAV,DECV,RAOPP,DECOPP,     00001
     2                 HB,OMEG,RINS,VA,VB,THETI,BETA,HA)                00002
          IMPLICIT REAL*8(A-H,O-Z)                                      00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE DVEL (JGIDE,AB,DVMAG,DELTAV,RAV,DECV,RAOPP,DECOPP,     00006
C                      HB,OMEG,RINS,VA,VB,THETI,BETA,HA)                00007
C                                                                       00008
C                                                                       00009
C                                                                       00010
C     THE PURPOSE OF DVEL IS TO DETERMINE THE DELTA V VECTOR AND        00011
C         SATELLITE ATTITUDE DURING A CHANGE-OF-ORBIT MANEUVER.         00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/O       DEFINITION                       00018
C                                                                       00019
C          JGIDE     I*4      I      FLAG FOR CHOOSING GUIDANCE OPTION--00020
C                                       =1, SPECIFY NEW ORBITAL PLANE   00021
C                                           (GIVEN BY HB) AND DVMAG.    00022
C                                           COMPUTE VB, AB, DELTAV.     00023
C                                       =2, SPECIFY NEW ORBITAL PLANE   00024
C                                           (GIVEN BY HB) AND AB.       00025
C                                           COMPUTE VB, DELTAV, DVMAG.  00026
C                                       =3, TEMPORARILY SPECIFY NEW     00027
C                                           ORBITAL PLANE (GIVEN BY HB) 00028
C                                           AND AB. VB IS THUS TEMPORA- 00029
C                                           RILY DETERMINED, RESULTING  00030
C                                           IN A SPECIFIC DIRECTION FOR 00031
C                                           DELTAV.                     00032
C                                           SPECIFY DVMAG. NOW DELTAV IS00033
C                                           FULLY DETERMINED.           00034
C                                           NOW RE-COMPUTE VB.          00035
C                                           ELEMENTS OF NEW ORBIT MUST  00036
C                                           BE RE-COMPUTED BY THE       00037
C                                           CALLING SUBROUTINE.         00038
C                                       =+4, INPUT THE MANEUVER POINT   00039
C                                            (TA) AND THE DELTAV VECTOR 00040
C                                            (DVMAG,THETI,BETA). COMPUTE00041
C                                            THE NEW VELCOITY VECTOR.   00042
C          AB        R*8     I/O     SEMI-MAJOR AXIS OF NEW ORBIT (KM)  00043
C          DVMAG     R*8     I/O     MAGNITUDE OF THE MANEUVER VELOCITY 00044
C                                       (DELTAV) VECTOR (KM/SEC)        00045
C          DELTAV(3) R*8      O      MANEUVER VELOCITY VECTOR (KM/SEC)  00046
C          RAV       R*8      O      RIGHT ASCENSION OF SATELLITE SPIN  00047
C                                       AXIS ASSUMED TO LIE ALONG DELTAV00048
C                                       (DEGREES)                       00049
C          DECV      R*8      O      DECLINATION OF SATELLITE SPIN AXIS 00050
C                                       ASSUMED TO LIE ALONG DELTAV     00051
C                                       (DEGREES)                       00052
C          RAOPP     R*8      O      RIGHT ASCENSION OF SATELLITE SPIN  00053
C                                       AXIS ASSUMED TO LIE ALONG       00054
C                                       NEGATIVE OF DELTAV (DEGREES)    00055
C          DECOPP    R*8      O      DECLINATION OF SATELLITE SPIN AXIS 00056
C                                       ASSUMED TO LIE ALONG NEGATIVE OF00057
C                                       DELTAV (DEGREES)                00058
C          HB(3)     R*8      I      ANGULAR MOMENTUM UNIT VECTOR OF    00059
C                                       NEW ORBIT                       00060
C          OMEG(3)   R*8      I      UNIT VECTOR TO INSERTION POINT INTO00061
C                                       NEW ORBIT (LIES ALONG LINE OF   00062
C                                       RELATIVE NODES)                 00063
C          RINS      R*8      I      MAGNITUDE OF INSERTION POINT       00064
C                                       POSITION VECTOR (KM)            00065
C          VA(3)     R*8      I      VELOCITY VECTOR IN OLD ORBIT       00066
C                                       IMMEDIATELY BEFORE INSERTION    00067
C                                       INTO NEW ORBIT (KM/SEC)         00068
C          VB(3)     R*8      O      VELOCITY VECTOR IN NEW ORBIT       00069
C                                       IMMEDIATELY AFTER INSERTION     00070
C                                       (KM/SEC)                        00071
C          THETI     R*8      I      THE DECLINATION ANGLE FOR DELTAV   00072
C                                       WITH RESPECT TO THE LOCAL       00073
C                                       TANGENT PLANE. IF THETI=0, THEN 00074
C                                       DELTAV IS PERPENDICULAR TO THE  00075
C                                       RADIUS VECTOR. IF THETI=+PI/2,  00076
C                                       THEN DELTAV IS ALONG THE        00077
C                                       POSITIVE RADIUS VECTOR.         00078
C                                       (RADIANS)                       00079
C          BETA      R*8      I      THE RIGHT ASCENSION ANGLE FOR      00080
C                                       DELTAV MEASURED AS A RIGHT HAND 00081
C                                       ROTATION ABOUT THE RADIUS VECTOR00082
C                                       IN THE LOCAL TANGENT PLANE. BETA00083
C                                       IS MEASURED FROM THE VECTOR     00084
C                                       FORMED BY THE ANGULAR MOMENTUM  00085
C                                       CROSSED WITH THE RADIUS VECTOR. 00086
C                                       IF BETA=0, THEN THERE IS NO     00087
C                                       PLANE CHANGE.  (RADIANS)        00088
C          HA        R*8      I      THE ANGULAR MOMENTUM UNIT VECTOR   00089
C                                       FOR THE OLD ORBIT               00090
C                                                                       00091
C                                                                       00092
C                                                                       00093
C     DVEL IS CALLED BY THE FOLLOWING SUBROUTINE.                       00094
C                                                                       00095
C         INSERT                                                        00096
C                                                                       00097
C                                                                       00098
C                                                                       00099
C     THE FOLLOWING SUBROUTINE IS CALLED BY DVEL.                       00100
C                                                                       00101
C         XPROD                                                         00102
C                                                                       00103
C                                                                       00104
C                                                                       00105
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY DVEL.              00106
C                                                                       00107
C         DOT                                                           00108
C                                                                       00109
C                                                                       00110
C                                                                       00111
C     DVEL NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00112
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00113
C                                                                       00114
C                                                                       00115
      DIMENSION VA(3),HB(3),OMEG(3),DELTAV(3),VB(3)                     00116
      DIMENSION HA(3),XX(3)                                             00117
      DATA PI,U,DR/3.1415926535897932D0,398600.8D0,0.017453292519943D0/ 00118
      DATA CCCLX,CLXXX /360.D0,180.D0/                                  00119
      IF(JGIDE .LT. 1 .OR. JGIDE .GT. 4) GO TO 250                      00120
      IF(JGIDE .EQ. 4) GO TO 116                                        00121
C**GIVEN ORBITAL PLANE OF NEW ORBIT AS SPECIFIED BY HB, COMPUTE UNITIZED00122
C     VELOCITY VECTOR AFTER INSERTION.                                  00123
      CALL XPROD(HB,OMEG,VB,CMAG,1)                                     00124
      IF (JGIDE .NE. 1) GO TO 50                                        00125
C                                                                       00126
C**1ST GUIDANCE OPTION --                                               00127
C     COMPUTE MAGNITUDE OF VELOCITY VECTOR AFTER INSERTION INTO NEW OR- 00128
C     BIT, BASED ON AN INPUT MAGNITUDE FOR DELTAV.  (NOTE --            00129
      VAMAG = DSQRT(VA(1)**2 + VA(2)**2 + VA(3)**2)                     00130
      ETA = DARCOS(DOT(VA,VB)/VAMAG)                                    00131
      THETA = DARSIN(VAMAG*DSIN(ETA)/DVMAG)                             00132
      ZETA = PI-THETA-ETA                                               00133
      COSLAW = VAMAG**2. + DVMAG**2. - 2.D0*VAMAG*DVMAG*DCOS(ZETA)      00134
      IF (COSLAW .LT. 0.D0) GO TO 150                                   00135
      VBMAG = DSQRT(COSLAW)                                             00136
C     CALC. SEMI-MAJOR AXIS OF B FROM VIS-VIVA EQN.                     00137
      AB = U*RINS / (2.D0*U - RINS*VBMAG*VBMAG)                         00138
C                                                                       00139
C**CONTINUE W/ ALL 3 GUIDANCE OPTIONS.                                  00140
C     COMPUTE MAGNITUDE OF VELOCITY VECTOR AFTER INSERTION INTO NEW OR- 00141
C     BIT, BASED ON VALUE OF AB.                                        00142
   50 VBMAG = DSQRT(U*(2.D0/RINS-1.D0/AB))                              00143
C     CALCULATE DELTAV VECTOR BASED ON ABOVE VECTOR VB                  00144
      DVIN = DVMAG                                                      00145
      DO 105 J=1,3                                                      00146
      VB(J) = VBMAG * VB(J)                                             00147
  105 DELTAV(J) = VB(J) - VA(J)                                         00148
      DVMAG = DSQRT(DELTAV(1)**2 + DELTAV(2)**2 + DELTAV(3)**2    )     00149
      IF (JGIDE .NE. 3) GO TO 120                                       00150
C                                                                       00151
C**3RD GUIDANCE OPTION --                                               00152
      DO 110 J=1,3                                                      00153
  110 DELTAV(J) = DELTAV(J)/DVMAG                                       00154
C     USE THE INPUT MAGNITUDE OF DELTAV TO DETERMINE THE DELTAV VECTOR. 00155
C     THEN RE-CALCULATE THE VB VECTOR BASED ON THIS.                    00156
      DVMAG = DVIN                                                      00157
      DO 115 J=1,3                                                      00158
      DELTAV(J)=DVMAG*DELTAV(J)                                         00159
  115 VB(J) = VA(J) + DELTAV(J)                                         00160
  116 IF(JGIDE .NE. 4) GO TO 120                                        00161
      CALL XPROD(HA,OMEG,XX,XXM,1)                                      00162
      CT = DCOS(THETI)                                                  00163
      ST = DSIN(THETI)                                                  00164
      CBT = DCOS(BETA)                                                  00165
      SBT = DSIN(BETA)                                                  00166
      DO 119 K=1,3                                                      00167
      DELTAV(K) = DVMAG*(CT*CBT*XX(K) + CT*SBT*HA(K) + ST*OMEG(K))      00168
  119 VB(K) = VA(K) + DELTAV(K)                                         00169
C**CONTINUE W/ ALL THREE GUIDANCE OPTIONS.                              00170
C     AT THIS POINT THE DELTAV VECTOR AND ITS MAGNITUDE, DVMAG, HAS BEEN00171
C        FOUND FOR ALL FOUR GUIDANCE CASES. SO HAS THE VB VECTOR.       00172
  120 RAV   = DATAN2 (DELTAV(2), DELTAV(1) )  / DR                      00173
      IF (RAV .LT. 0.D0)  RAV = RAV + CCCLX                             00174
      RAOPP = RAV + CLXXX                                               00175
      IF (RAOPP .GE. CCCLX)  RAOPP = RAOPP - CCCLX                      00176
      DECV  = DATAN2 (DELTAV(3), DSQRT(DELTAV(1)**2+DELTAV(2)**2) )  /DR00177
      DECOPP=-DECV                                                      00178
      RETURN                                                            00179
  150 WRITE (6,1002) VAMAG, DVMAG, ETA, COSLAW                          00180
      STOP                                                              00181
  250 WRITE (6,1001) JGIDE                                              00182
      STOP                                                              00183
 1001 FORMAT (1H0,'FATAL MESSAGE FROM DVEL. JGIDE=',I3,', BUT ONLY VALUE00184
     2S OF 1, 2, OR 3 ARE MEANINGFUL. CHECK NAMELIST INPUT.')           00185
 1002 FORMAT (1H0,'FATAL MESSAGE FROM DVEL. USER CHOSE GUIDANCE OPTION J00186
     2GIDE=1, BUT HIS INPUT MAGNITUDE FOR DELTAV WAS INSUFFICIENT FOR AC00187
     3HIEVING'/' THE ORBITAL PLANE DESIRED FOR THE NEW ORBIT.'/'0SPEED I00188
     4N OLD ORBIT = VAMAG = ',D17.10,' KM/SEC'/' INPUT MAGNITUDE FOR DEL00189
     5TAV = DVMAG = ',D17.10,' KM/SEC'/' ANGLE BETWEEN VELOCITY VECTORS 00190
     6IN OLD & NEW ORBITS AT INSERTION POINT = ETA = ',D17.10,' RADIANS'00191
     7/' SQUARE OF SPEED IN NEW ORBIT AFTER INSERTION = ',D17.10,', SO S00192
     8PEED WOULD BE AN IMAGINARY NUMBER.')                              00193
      END                                                               00194
C          DATA SET EHA        AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE EHA(TW,TF,DA,RA,OMEGA)                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE EHA (TW,TF,DA,RA,OMEGA)                                00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSES OF EHA ARE TO COMPUTE THE RIGHT ASCENSION OF THE     00000090
C         GREENWICH MERIDIAN AT ANY GIVEN DAY AND TIME SINCE 1950.0     00000100
C         AND TO COMPUTE THE EARTH'S ANGULAR ROTATION RATE.             00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IS THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          TW        R*8      I      WHOLE DAYS PAST 1950.0             00000190
C          TF        R*8      I      FRACTIONAL DAYS                    00000200
C          DA        R*8      I      NUTATION IN RIGHT ASCENSION        00000210
C                                       (RADIANS)                       00000220
C          RA        R*8      O      RIGHT ASCENSION OF GREENWICH       00000230
C                                       MERIDIAN (RADIANS)              00000240
C          OMEGA     R*8      O      EARTH'S ANGULAR ROTATION RATE      00000250
C                                       (RAD/SEC)                       00000260
C                                                                       00000270
C                                                                       00000280
C     EHA IS CALLED BY THE FOLLOWING SUBROUTINE.                        00000290
C                                                                       00000300
C         LATIME                                                        00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     NO SUBROUTINES ARE CALLED BY EHA.                                 00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY EHA.               00000390
C                                                                       00000400
C         AMUD                                                          00000410
C                                                                       00000420
C                                                                       00000430
C                                                                       00000440
C     EHA NEITHER USES NOR ALTERS VARIABLES IN COMMON.                  00000450
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000460
C                                                                       00000470
C                                                                       00000480
C                                                                       00000490
      DATA SEC,TWOPI / 8.64D4,           6.2831853071795864D0/          00000500
      DATA C1,C2,C3  / 7.292115070D-5,   3.8D-17,      1.7466477191D0/  00000510
      DATA C4,C5     / 1.720279145D-2,   5.0641D-15/                    00000520
      OMEGA = C1 - C2*TW                                                00000530
      RA = AMUD(DA + OMEGA*TF*SEC + C3 + TW*(C4+TW*C5) , TWOPI)         00000540
      RETURN                                                            00000550
      END                                                               00000560
C          DATA SET ELMREC     AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE ELMREC(A,E,XINC,O,W,F,V,VMAG,J,R,RMAG)                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE ELMREC (A,E,XINC,O,W,F,V,VMAG,J,R,RMAG)                00000050
C                                                                       00000060
C                                                                       00000070
C     THE PURPOSE OF ELMREC IS TO TRANSFORM THE KEPLERIAN ELEMENTS OF AN00000080
C         EARTH-ORBITING SATELLITE INTO CARTESIAN POSITION AND VELOCITY 00000090
C         VECTORS.                                                      00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          A         R*8      I      SEMI-MAJOR AXIS (KM)               00000180
C          E         R*8      I      ECCENTRICITY                       00000190
C          XINC      R*8      I      INCLINATION (RADIANS)              00000200
C          O         R*8      I      RIGHT ASCENSION OF ASCENDING       00000210
C                                       NODE (RADIANS)                  00000220
C          W         R*8      I      ARGUMENT OF PERIGEE (RADIANS)      00000230
C          F         R*8      I      TRUE ANOMALY (RADIANS)             00000240
C          V(3)      R*8      O      VELOCITY VECTOR (KM/SEC)           00000250
C          VMAG      R*8      O      MAGNITUDE OF VELOCITY              00000260
C                                       VECTOR (KM/SEC)                 00000270
C          J         I*4      I      COMPUTATION FLAG--                 00000280
C                                       =0, COMPUTE ONLY VELOCITY VECTOR00000290
C                                       =1, COMPUTE ONLY POSITION VECTOR00000300
C                                       =ANY OTHER VALUE, COMPUTE BOTH  00000310
C                                        POSITION AND VELOCITY VECTORS  00000320
C          R(3)      R*8      O      POSITION VECTOR (KM)               00000330
C          RMAG      R*8      O      MAGNITUDE OF POSITION VECTOR (KM)  00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     ELMREC IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000380
C                                                                       00000390
C         ESSO      INSERT    MODE5     SUNOCO                          00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C     NO SUBROUTINES ARE CALLED BY ELMREC.                              00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     ELMREC NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000480
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
      DIMENSION V(3),R(3)                                               00000530
      U = 398600.8D0                                                    00000540
C     SEMILATUS RECTUM IS P                                             00000550
      P = A*(1.D0 - E * E)                                              00000560
      C = (DSQRT(U/P))                                                  00000570
      ECF = E + DCOS(F)                                                 00000580
      SF = DSIN(F)                                                      00000590
      CI = DCOS(XINC)                                                   00000600
      SI = DSIN(XINC)                                                   00000610
      CO = DCOS(O)                                                      00000620
      SO = DSIN(O)                                                      00000630
      IF (J .EQ. 1) GO TO 5                                             00000640
      CW = DCOS(W)                                                      00000650
      SW = DSIN(W)                                                      00000660
      V(1) = C * (ECF * (-SW * CO - CI * SO * CW) - SF * (CW * CO - CI  00000670
     * * SO * SW))                                                      00000680
      V(2) = C * (ECF * (-SW * SO + CI * CO * CW) - SF * (CW * SO + CI  00000690
     * * CO * SW))                                                      00000700
      V(3) = C * (ECF*SI*CW - SF*SI*SW)                                 00000710
      VMAG = DSQRT (V(1) * V(1) + V(2) * V(2) + V(3) * V(3))            00000720
C     IF NEEDED , CAN CALCULATE R-                                      00000730
      IF (J .EQ. 0) RETURN                                              00000740
    5 CWF = DCOS(W+F)                                                   00000750
      SWF = DSIN (W+F)                                                  00000760
      RMAG = P/(1.D0 + E * DCOS(F))                                     00000770
      R(1) = RMAG * (CO * CWF - SO * SWF * CI)                          00000780
      R(2) = RMAG * (SO * CWF + CO * SWF * CI)                          00000790
      R(3) = RMAG * SWF * SI                                            00000800
      RETURN                                                            00000810
      END                                                               00000820
C          DATA SET ESSO       AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE ESSO (A,E,INC,NODE,ARGP,PERIOD,TESSO,HELIOS,EXXON)     00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C*****ESSO STANDS FOR EARTH-SATELLITE-SUN OBLIQUITY --                  00000040
C     I.E., THE SUN-EARTH SEPARATION ANGLE AS SEEN FROM THE SATELLITE.  00000050
C                                                                       00000060
C                                                                       00000070
C     SUBROUTINE ESSO (A,E,INC,NODE,ARGP,PERIOD,TESSO,HELIOS,EXXON)     00000080
C                                                                       00000090
C                                                                       00000100
C                                                                       00000110
C     THE PURPOSE OF ESSO IS TO COMPUTE EARTH-SUN SEPARATION ANGLES AS  00000120
C         SEEN FROM A SATELLITE AT VARIOUS POSITIONS IN ITS ORBIT ABOUT 00000130
C         THE EARTH. THE ORBIT IS SPECIFIED IN TERMS OF KEPLERIAN       00000140
C         ELEMENTS.                                                     00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000190
C                                                                       00000200
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000210
C                                                                       00000220
C          A         R*8      I      SEMI-MAJOR AXIS (KM)               00000230
C          E         R*8      I      ECCENTRICITY                       00000240
C          INC       R*8      I      INCLINATION (RADIANS)              00000250
C          NODE      R*8      I      RIGHT ASCENSION OF ASCENDING       00000260
C                                       NODE (RADIANS)                  00000270
C          ARGP      R*8      I      ARGUMENT OF PERIGEE (RADIANS)      00000280
C          PERIOD    R*8      I      ORBITAL PERIOD (SECONDS)           00000290
C          TESSO     R*8      I      TIME AT WHICH SATELLITE BEGINS     00000300
C                                       TRAVERSING ORBITAL SEGMENT OF   00000310
C                                       INTEREST (IN SECONDS FROM       00000320
C                                       PERIGEE PASSAGE)                00000330
C          HELIOS(3) R*8      I      SOLAR POSITION VECTOR WITH RESPECT 00000340
C                                       TO EARTH AT NEAREST HALF-DAY TO 00000350
C                                       ENDTIME OF ORBITAL SEGMENT (KM) 00000360
C          EXXON(4)  R*8      O      EARTH-SUN SEPARATION ANGLES        00000370
C                                      (DEGREES)--                      00000380
C            (1)                        MAXIMUM VALUE ALONG ORBITAL     00000390
C                                          SEGMENT                      00000400
C            (2)                        MINIMUM VALUE ALONG ORBITAL     00000410
C                                          SEGMENT                      00000420
C            (3)                        VALUE AT APOGEE                 00000430
C            (4)                        VALUE AT TIME TESSO             00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     ESSO IS CALLED BY THE FOLLOWING SUBROUTINE.                       00000480
C                                                                       00000490
C         LAUCON                                                        00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
C     THE FOLLOWING SUBROUTINES ARE CALLED BY ESSO.                     00000540
C                                                                       00000550
C         ANGMOM    DEGRAD    ELMREC    SEP                             00000560
C                                                                       00000570
C                                                                       00000580
C                                                                       00000590
C     ESSO NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00000600
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000610
C                                                                       00000620
C                                                                       00000630
C                                                                       00000640
C                                                                       00000650
      REAL*8 INC,NODE                                                   00000660
      DIMENSION EXXON(4),HELIOS(3),UHELIO(3),R(3),DUMMY(3),H(3)         00000670
      DATA PI/3.1415926535897932D0/                                     00000680
C                                                                       00000690
C *** FIND EARTH-TO-SATELLITE VECTOR AT APOGEE IN THE ORBIT.            00000700
      CALL ELMREC (A,E,INC,NODE,ARGP,PI,DUMMY,DMAG,1,R,RMAG)            00000710
C                                                                       00000720
C *** FIND UNIT VECTORS --                                              00000730
C      --SATELLITE-TO-SUN NEAR ENDTIME OF SEGMENT (SAME AS EARTH-TO-SUN)00000740
C      --SATELLITE-TO-EARTH AT APOGEE                                   00000750
      HELMAG = DSQRT(HELIOS(1)**2 + HELIOS(2)**2 + HELIOS(3)**2)        00000760
      DO 5 K = 1,3                                                      00000770
      UHELIO(K) = HELIOS(K)/HELMAG                                      00000780
    5 R(K) = -R(K)/RMAG                                                 00000790
C                                                                       00000800
C *** COMPUTE SUN-EARTH SEPARATION ANGLES & CONVERT TO DEGREES.         00000810
      CALL ANGMOM (INC,NODE,H)                                          00000820
      CALL SEP (UHELIO,R,H,TESSO,E,PERIOD,SMAX,SMIN,SAPA,SAPB)          00000830
      CALL DEGRAD (0,EXXON(1),EXXON(2),EXXON(3),EXXON(4),               00000840
     2               SMAX,    SMIN,    SAPA,    SAPB)                   00000850
      RETURN                                                            00000860
      END                                                               00000870
C          DATA SET GEOM       AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE GEOM(OMEGA,REL,VES)                                    00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE GEOM (OMEGA,REL,VES)                                   00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF GEOM IS TO COMPUTE THE FOLLOWING QUANTITIES WITH   00000090
C         RESPECT TO A GREENWICH-REFERENCED COORDINATE SYSTEM--         00000100
C                                                                       00000110
C         (1) INJECTION POINT POSITION VECTOR FOR THE INITIAL ORBIT OF A00000120
C             MISSION SEQUENCE (GENERALLY ASSUMED DIRECTLY OVERHEAD OF  00000130
C             LAUNCH SITE)                                              00000140
C         (2) INJECTION VELOCITY VECTOR                                 00000150
C         (3) GEOGRAPHIC LONGITUDE OF THE ASCENDING NODE OF THE INITIAL 00000160
C             ORBIT (RADIANS)                                           00000170
C                                                                       00000180
C                                                                       00000190
C                                                                       00000200
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000210
C                                                                       00000220
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000230
C                                                                       00000240
C          OMEGA     R*8      O      GEOGRAPHIC LONGITUDE OF ASCENDING  00000250
C                                       NODE, IN RADIANS (ANGLE BETWEEN 00000260
C                                       GREENWICH AND ASCENDING NODE    00000270
C                                       VECTOR)                         00000280
C          REL(3)    R*8      O      INJECTION POINT POSITION VECTOR    00000290
C                                       WITH RESPECT TO GREENWICH       00000300
C                                       COORDINATES, IN SAME UNITS      00000310
C                                       AS RMAG                         00000320
C          VES(3)    R*8      O      INJECTION VELOCITY VECTOR WITH     00000330
C                                       RESPECT TO GREENWICH            00000340
C                                       COORDINATES, IN SAME UNITS      00000350
C                                       AS VMAG                         00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     GEOM IS CALLED BY THE FOLLOWING SUBROUTINES.                      00000400
C                                                                       00000410
C         MODE DRIVERS                                                  00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C     THE FOLLOWING SUBROUTINE IS CALLED BY GEOM.                       00000460
C                                                                       00000470
C         XPROD                                                         00000480
C                                                                       00000490
C                                                                       00000500
C                                                                       00000510
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY GEOM.              00000520
C                                                                       00000530
C         DOT                                                           00000540
C                                                                       00000550
C                                                                       00000560
C                                                                       00000570
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000580
C                                                                       00000590
C         COMMON VARIABLES USED                                         00000600
C                                                                       00000610
C         AZIM      LAT       RMAG                                      00000620
C         ELEV      LON       VMAG                                      00000630
C                                                                       00000640
C                                                                       00000650
C                                                                       00000660
C                                                                       00000670
      REAL*8 LAT,LON                                                    00000680
      COMMON/ONEONE/LAT,LON,RMAG,AZIM,ELEV,VMAG                         00000690
      DIMENSION REL(3),XE(3),ZE(3),XL(3),YL(3),ZL(3),VLS(3),VES(3),H(3),00000700
     2          RNODE(3),XCROSO(3)                                      00000710
C                                                                       00000720
C**   INITIAL COORDINATE SYSTEM- GREENWICH-FIXED                        00000730
      DATA XE,ZE /1.D0,0.D0,0.D0,0.D0,0.D0,1.D0/                        00000740
C*****1. INJ. SITE VECTOR (W/R/T GREENWICH COORDS)                      00000750
C         (COULD ASSUME INJ. DIRECTLY OVERHEAD OF LAUNCH SITE)          00000760
      REL(1) = DCOS(LAT) * DCOS(LON) * RMAG                             00000770
      REL(2) = DCOS(LAT) * DSIN(LON) * RMAG                             00000780
      REL(3) = DSIN(LAT) * RMAG                                         00000790
C*****2. INJ. COORDINATE SYSTEM UNIT VECTORS (W/R/T GREENWICH COORDS)   00000800
      DO 5 J=1,3                                                        00000810
   5  ZL(J) = -REL(J) / RMAG                                            00000820
      CALL XPROD(ZL,ZE,YL,CMAG,1)                                       00000830
      CALL XPROD(YL,ZL,XL,CMAG,0)                                       00000840
C*****3. INJ. VELOCITY (I.E. INJ. DIRECTION) VECTOR (W/R/T INJ. COORDS) 00000850
      VLS(1) = DCOS(ELEV) * DCOS(AZIM) * VMAG                           00000860
      VLS(2) = DCOS(ELEV) * DSIN(AZIM) * VMAG                           00000870
      VLS(3) = DSIN(ELEV) * VMAG                                        00000880
C*****4. ROTATION MATRIX, INJ-TO-GREENWICH SYSTEMS, IS USED TO ROTATE   00000890
C        VELOCITY VECTOR                                                00000900
      DO 15 J = 1,3                                                     00000910
   15 VES(J) = XL(J) * VLS(1) + YL(J) * VLS(2) + ZL(J) * VLS(3)         00000920
C*****5. ANGULAR MOMENTUM UNIT VECTOR, ORBIT 1 (GRNWICH COORDS)         00000930
      CALL XPROD(REL,VES,H,CMAG,1)                                      00000940
C     NODE UNIT VECTOR, ORBIT 1 (GRNWICH COORDS)                        00000950
      CALL XPROD (ZE,H,RNODE,CMAG,1)                                    00000960
C*****6.LONGITUDE OF ASCENDING NODE (GRNWICH COORDS)                    00000970
      CALL XPROD (XE,RNODE,XCROSO,CMAG,0)                               00000980
      OMEGA = DATAN2 ( DOT(XCROSO,ZE), DOT(XE,RNODE) )                  00000990
      RETURN                                                            00001000
      END                                                               00001010
C          DATA SET INPUT1     AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE INPUT1                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****NAMELIST INPUT*****                                               00000030
C     THE VARIABLES ARE DESCRIBED IN THE ROUTINES WHERE THEY ARE EXTEN- 00000040
C     SIVELY USED. THE FOLLOWING TABLE INDICATES BY COMMON BLOCK WHERE  00000050
C     THESE VARIABLE DESCRIPTIONS MAY BE FOUND --                       00000060
C  /SCANS/                    MODE DRIVER ROUTINE                       00000070
C  /ONEONE/                   GEOM                                      00000080
C  /ONECAN/                   LAUCON,MODE                               00000090
C**TAKE NOTE -- DNOD,DTIME MUST NOT BE 0.D0                             00000100
C               JDATE MUST BE AN INTEGRAL NUMBER OF DAYS.               00000110
C     ALL ANGLES ARE INPUT IN DEGREES, THEN CHANGED INTERNALLY TO       00000120
C         RADIANS. ALL ANGLES IN COMMON BLOCKS ARE IN RADIANS.          00000130
C                                                                       00000140
      REAL*8 LAT,LON,NLAT                                               00000150
      NAMELIST/ORB/JSCAN,TLINJ,SDATE,FDATE,JDATE,SNOD,FNOD,DNOD,STIME,  00000160
     2                              FTIME,DTIME,                        00000170
     3  NLAT,ELON,RMAG,AZ,FPA,VMAG,                                     00000180
     4  TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1                            00000190
     7 ,MSUN,MORB,MOFLAG,M,MPLOT,OUTA,OUTB,OUTC,OUTD,OUTE,OUTF,OUTG     00000200
     8 ,MDISK                                                           00000210
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00000220
     2             SDATE,FDATE,JDATE,JSCAN                              00000230
      COMMON/ONEONE/LAT,LON,RMAG,AZIM,ELEV,VMAG                         00000240
      COMMON/ONECAN/TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1                00000250
      COMMON/CODES/ OUTA(11), OUTB(11), OUTC(11), OUTD(11), OUTE(11),   00000260
     2              OUTF(11), OUTG(11), M(7), MPLOT, MDISK              00000270
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000280
      DATA DUMMY1  /0.D0/                                               00000290
      READ (5,ORB)                                                      00000300
      CALL DEGRAD (1,SNOD,FNOD,DNOD,DUMMY1,SNODE,FNODE,DNODE,DUMMY2)    00000310
      CALL DEGRAD (1,NLAT,ELON,AZ,  FPA,   LAT,  LON,  AZIM, ELEV)      00000320
C     CHECK FOR USER INPUT ERRORS                                       00000330
      IF ((JSCAN .NE. 1) .AND. (JSCAN .NE. 2)) GO TO 100                00000340
      IF ((JSCAN .EQ. 1) .AND. (DNODE .EQ. 0.D0)) DNODE=1.D4            00000350
      IF ((JSCAN .EQ. 2) .AND. (DTIME .EQ. 0.D0)) DTIME=1.D4            00000360
      RETURN                                                            00000370
  100 WRITE (6,1001) JSCAN                                              00000380
 1001 FORMAT (1H0,'INPUT1 FATAL ERROR. JSCAN=',I3,', BUT ONLY VALUES OF 00000390
     21 (NODE SCAN) OR 2 (TIME SCAN) ARE MEANINGFUL. CHECK NAMELIST INPU00000400
     3T.')                                                              00000410
      STOP                                                              00000420
      END                                                               00000430
C          DATA SET INPUT2     AT LEVEL 001 AS OF 12/06/78              00000000
      SUBROUTINE INPUT2                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****NAMELIST INPUT*****THE VARIABLES ARE DESCRIBED IN THE ROUTINES    00000030
C     WHERE THEY ARE EXTENSIVELY USED. THE FOLLOWING TABLE INDICATES BY 00000040
C     COMMON BLOCK WHERE THESE VARIABLE DESCRIPTIONS MAY BE FOUND --    00000050
C  /SCANS/                    MODE DRIVER ROUTINE                       00000060
C  /ONEONE/                   GEOM                                      00000070
C  /TWO/                      DVEL,NODROT,INSERT                        00000080
C  /ONECAN/,/TWOCAN/          LAUCON,MODE                               00000090
C     ALL ANGLES ARE INPUT IN DEGREES, THEN CHANGED INTERNALLY TO       00000100
C         RADIANS. ALL ANGLES IN COMMON BLOCKS ARE IN RADIANS.          00000110
C**TAKE NOTE -- DNOD,DTIME MUST NOT BE 0.D0.                            00000120
C               JDATE MUST BE AN INTEGRAL NUMBER OF DAYS.               00000130
C                                                                       00000140
      REAL*8 I2,LAT,LON,INC2,NLAT,NOD2,NODE2                            00000150
      NAMELIST/ORB/JSCAN,TLINJ,SDATE,FDATE,JDATE,SNOD,FNOD,DNOD,STIME,  00000160
     2                              FTIME,DTIME,                        00000170
     3  NLAT,ELON,RMAG,AZ,FPA,VMAG,                                     00000180
     4  TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1,                           00000190
     5   A2,DV2,JGIDE2,I2,NOD2,DN2MAX,JNOD2,JINS2,ARG2P,                00000200
     * TH2,B2,TRUE1,                                                    00000210
     6  TESSO2,ARC2,KCAN2,KREVS2,JUMB2,JPEN2                            00000220
     7 ,MSUN,MORB,MOFLAG,M,MPLOT,OUTA,OUTB,OUTC,OUTD,OUTE,OUTF,OUTG     00000230
     8 ,MDISK,JREL3                                                     00000240
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00000250
     2             SDATE,FDATE,JDATE,JSCAN                              00000260
      COMMON/ONEONE/LAT,LON,RMAG,AZIM,ELEV,VMAG                         00000270
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000280
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000290
      COMMON/ONECAN/TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1                00000300
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2,KREVS2,JUMB2,JPEN2                00000310
      COMMON/CODES/ OUTA(11), OUTB(11), OUTC(11), OUTD(11), OUTE(11),   00000320
     2              OUTF(11), OUTG(11), M(7), MPLOT, MDISK              00000330
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000340
      COMMON/DGREE2/ NOD2,DN2MAX,TH2,B2,TRUE1                           00000350
      DATA DUMMY1  /0.D0/                                               00000360
C                                                                       00000370
C     READ NAMELIST AND CHANGE ANGLES TO RADIANS.                       00000380
      ARG2P=ARGPI2                                                      00000390
      READ (5,ORB)                                                      00000400
      CALL DEGRAD (1,SNOD,FNOD,DNOD,DUMMY1,SNODE,FNODE,DNODE,DUMMY2)    00000410
      CALL DEGRAD (1,NLAT,ELON,AZ,  FPA,   LAT,  LON,  AZIM, ELEV)      00000420
      CALL DEGRAD (1,I2,NOD2,DN2MAX,ARG2P,INC2,NODE2,DNMAX2,ARGPI2)     00000430
      CALL DEGRAD(1,TH2,B2,TRUE1,DUMMY1,THETA2,BETA2,TA1,DUMMY2)        00000440
C                                                                       00000450
C     CHECK FOR USER INPUT ERRORS                                       00000460
      IF ((JSCAN .NE. 1) .AND. (JSCAN .NE. 2)) GO TO 100                00000470
      IF ((JSCAN .EQ. 1) .AND. (DNODE .EQ. 0.D0)) DNODE=1.D4            00000480
      IF ((JSCAN .EQ. 2) .AND. (DTIME .EQ. 0.D0)) DTIME=1.D4            00000490
      RETURN                                                            00000500
  100 WRITE (6,1001) JSCAN                                              00000510
 1001 FORMAT (1H0,'INPUT2 FATAL ERROR. JSCAN=',I3,', BUT ONLY VALUES OF 00000520
     21 (NODE SCAN) OR 2 (TIME SCAN) ARE MEANINGFUL. CHECK NAMELIST INPU00000530
     3T.')                                                              00000540
      STOP                                                              00000550
      END                                                               00000560
C          DATA SET INPUT3     AT LEVEL 001 AS OF 12/06/78              00000000
      SUBROUTINE INPUT3                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE INPUT3                                                 00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSES OF INPUT3 ARE TO READ THE NAMELIST INPUT (ORB) FOR A 00000090
C         MODE=3 RUN AND TO CONVERT ALL INPUT ANGLES FROM DEGREES       00000100
C         TO RADIANS.                                                   00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL INPUT AND     00000150
C         OUTPUT VARIABLES ARE PASSED THROUGH COMMON OR ARE READ IN     00000160
C         THROUGH THE NAMELIST ORB.                                     00000170
C                                                                       00000180
C                                                                       00000190
C                                                                       00000200
C     INPUT3 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000210
C                                                                       00000220
C         MODE3                                                         00000230
C                                                                       00000240
C                                                                       00000250
C                                                                       00000260
C     THE FOLLOWING SUBROUTINE IS CALLED BY INPUT3.                     00000270
C                                                                       00000280
C         DEGRAD                                                        00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000330
C                                                                       00000340
C         COMMON VARIABLES USED                                         00000350
C                                                                       00000360
C         DN2MAX    DN3MAX    NOD2      NOD3                            00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C         COMMON VARIABLES COMPUTED                                     00000410
C                                                                       00000420
C         AZIM      DNODE     FNODE     INC3      LON       NODE3       00000430
C         DNMAX2    ELEV      INC2      LAT       NODE2     SNODE       00000440
C         DNMAX3                                                        00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
C         COMMON VARIABLES USED AND COMPUTED                            00000490
C                                                                       00000500
C         A2        FRAC3     JPEN1     KCAN3(20) MSUN      RMAG        00000510
C         A3        FTIME     JPEN2     KREVS1    OUTA(11)  SDATE       00000520
C         ARC1      JDATE     JPEN3     KREVS2    OUTB(11)  STIME       00000530
C         ARC2      JGIDE2    JSCAN     KREVS3    OUTC(11)  TESSO1      00000540
C         ARC3      JGIDE3    JUMB1     M(7)      OUTD(11)  TESSO2      00000550
C         DTIME     JINS2     JUMB2     MDISK     OUTE(11)  TESSO3      00000560
C         DV2       JINS3     JUMB3     MOFLAG    OUTF(11)  TLINJ       00000570
C         DV3       JNOD2     KCAN1(20) MORB      OUTG(11)  VMAG        00000580
C         FDATE     JNOD3     KCAN2(20) MPLOT                           00000590
C                                                                       00000600
C                                                                       00000610
C                                                                       00000620
C     THE FOLLOWING VARIABLES MAY BE READ IN THROUGH THE NAMELIST ORB-- 00000630
C                                                                       00000640
C         A2        DV3       JGIDE3    JUMB3     MPLOT     OUTG(11)    00000650
C         A3        ELON      JINS2     KCAN1(20) MSUN      RMAG        00000660
C         ARC1      FDATE     JINS3     KCAN2(20) NLAT      SDATE       00000670
C         ARC2      FNOD      JNOD2     KCAN3(20) NOD2      SNOD        00000680
C         ARC3      FPA       JNOD3     KREVS1    NOD3      STIME       00000690
C         AZ        FRAC3     JPEN1     KREVS2    OUTA(11)  TESSO1      00000700
C         DN2MAX    FTIME     JPEN2     KREVS3    OUTB(11)  TESSO2      00000710
C         DN3MAX    I2        JPEN3     M(7)      OUTC(11)  TESSO3      00000720
C         DNOD      I3        JSCAN     MDISK     OUTD(11)  TLINJ       00000730
C         DTIME     JDATE     JUMB1     MOFLAG    OUTE(11)  VMAG        00000740
C         DV2       JGIDE2    JUMB2     MORB      OUTF(11)              00000750
C                                                                       00000760
C                                                                       00000770
C                                                                       00000780
      REAL*8 I2,I3,LAT,LON,INC2,INC3,NLAT,NOD2,NOD3,NODE2,NODE3         00000790
      NAMELIST/ORB/JSCAN,TLINJ,SDATE,FDATE,JDATE,SNOD,FNOD,DNOD,STIME,  00000800
     2                              FTIME,DTIME,                        00000810
     3  NLAT,ELON,RMAG,AZ,FPA,VMAG,                                     00000820
     *  TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1,                           00000830
     4   A2,DV2,JGIDE2,I2,NOD2,DN2MAX,JNOD2,JINS2,ARG2P,                00000840
     * TH2,B2,TRUE1,                                                    00000850
     *  TESSO2,ARC2,KCAN2,KREVS2,JUMB2,JPEN2,                           00000860
     5   A3,DV3,JGIDE3,I3,NOD3,DN3MAX,JNOD3,JINS3,ARG3P,                00000870
     * TH3,B3,TRUE2,                                                    00000880
     *  FRAC3,TESSO3,ARC3,KCAN3,KREVS3,JUMB3,JPEN3,                     00000890
     6  MSUN,MORB,MOFLAG,OUTA,OUTB,OUTC,OUTD,OUTE,OUTF,OUTG,M,MPLOT,    00000900
     7  MDISK,JREL3                                                     00000910
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00000920
     2             SDATE,FDATE,JDATE,JSCAN                              00000930
      COMMON/ONEONE/LAT,LON,RMAG,AZIM,ELEV,VMAG                         00000940
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000950
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000960
      COMMON/THREE/ A3,DV3, INC3, NODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00000970
     *              JGIDE3,JNOD3,JINS3                                  00000980
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000990
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2            00001000
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3(20),KREVS3,JUMB3,JPEN3      00001010
      COMMON/CODES/ OUTA(11), OUTB(11),OUTC(11),OUTD(11),OUTE(11),      00001020
     2              OUTF(11),OUTG(11),M(7),MPLOT,MDISK                  00001030
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00001040
      COMMON/DGREE3/ NOD2,DN2MAX,NOD3,DN3MAX,TH2,B2,TRUE1,TH3,B3,TRUE2  00001050
      DATA DUMMY1 /0.D0/                                                00001060
      ARG2P=ARGPI2                                                      00001070
      ARG3P=ARGPI3                                                      00001080
      READ (5,ORB)                                                      00001090
      CALL DEGRAD (1,SNOD,FNOD,DNOD,DUMMY1,SNODE,FNODE,DNODE,DUMMY2)    00001100
      CALL DEGRAD (1,NLAT,ELON,AZ,FPA,LAT,LON,AZIM,ELEV)                00001110
      CALL DEGRAD (1,I2,NOD2,DN2MAX,ARG2P,INC2,NODE2,DNMAX2,ARGPI2)     00001120
      CALL DEGRAD(1,TH2,B2,TRUE1,DUMMY1,THETA2,BETA2,TA1,DUMMY2)        00001130
      CALL DEGRAD (1,I3,NOD3,DN3MAX,ARG3P,INC3,NODE3,DNMAX3,ARGPI3)     00001140
      CALL DEGRAD(1,TH3,B3,TRUE2,DUMMY1,THETA3,BETA3,TA2,DUMMY2)        00001150
C     CHECK FOR USER INPUT ERRORS                                       00001160
      IF ((JSCAN .NE. 1) .AND. (JSCAN .NE. 2)) GO TO 100                00001170
      IF ((JSCAN .EQ. 1) .AND. (DNODE .EQ. 0.D0)) DNODE = 1.D4          00001180
      IF ((JSCAN .EQ. 2) .AND. (DTIME .EQ. 0.D0)) DTIME = 1.D4          00001190
      RETURN                                                            00001200
  100 WRITE (6,1001) JSCAN                                              00001210
 1001 FORMAT (1H0,'INPUT3 FATAL ERROR. JSCAN=',I3,', BUT ONLY VALUES OF 00001220
     21 (NODE SCAN) AND 2 (TIME SCAN) ARE MEANINGFUL. CHECK NAMELIST INP00001230
     3UT.')                                                             00001240
      STOP                                                              00001250
      END                                                               00001260
C          DATA SET INPUT4     AT LEVEL 001 AS OF 12/06/78              00000000
      SUBROUTINE INPUT4                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****NAMELIST INPUT*****THE VARIABLES ARE DESCRIBED IN THE ROUTINES    00000030
C     WHERE THEY ARE EXTENSIVELY USED. THE FOLLOWING TABLE INDICATES    00000040
C     BY COMMON BLOCK WHERE THESE VARIABLE DESCRIPTIONS MAY NE FOUND -- 00000050
C  /SCANS/                                   MODE DRIVER ROUTINE        00000060
C  /ONEONE/                                  GEOM                       00000070
C  /TWO/,/THREE/                             DVEL,NODROT,INSERT         00000080
C  /FOUR/                                    MODE4                      00000090
C  /ONECAN/,/TWOCAN/,/THRCAN/,/FOURCA/       LAUCON,MODE                00000100
C     ALL ANGLES ARE INPUT IN DEGREES, THEN CHANGED INTERNALLY TO       00000110
C         RADIANS. ALL ANGLES IN COMMON BLOCKS ARE IN RADIANS.          00000120
C**TAKE NOTE -- DNOD,DTIME MUST NOT BE 0.D0.                            00000130
C               JDATE MUST BE AN INTEGRAL NUMBER OF DAYS.               00000140
C                                                                       00000150
      REAL*8 I2,I3,I4,LAT,LON,INC2,INC3,INC4,NLAT,NOD2,NOD3,NOD4,NODE2, 00000160
     2       NODE3,NODE4                                                00000170
      NAMELIST/ORB/JSCAN,TLINJ,SDATE,FDATE,JDATE,SNOD,FNOD,DNOD,STIME,  00000180
     2                              FTIME,DTIME,                        00000190
     3  NLAT,ELON,RMAG,AZ,FPA,VMAG,                                     00000200
     *  TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1,                           00000210
     4   A2,DV2,JGIDE2,I2,NOD2,DN2MAX,JNOD2,JINS2,ARG2P,                00000220
     *  TESSO2,ARC2,KCAN2,KREVS2,JUMB2,JPEN2,                           00000230
     * TH2,B2,TRUE1,                                                    00000240
     5   A3,DV3,JGIDE3,I3,NOD3,DN3MAX,JNOD3,JINS3,ARG3P,                00000250
     *  FRAC3,TESSO3,ARC3,KCAN3,KREVS3,JUMB3,JPEN3,                     00000260
     * TH3,B3,TRUE2,                                                    00000270
     6  A4,E4,I4,NOD4,AOP4,TRUE4,                                       00000280
     *  FRAC4,TESSO4,ARC4,KCAN4,KREVS4,JUMB4,JPEN4                      00000290
     7 ,MSUN,MORB,MOFLAG,M,MPLOT,OUTA,OUTB,OUTC,OUTD,OUTE,OUTF,OUTG     00000300
     * ,MDISK,JREL3                                                     00000310
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00000320
     2             SDATE,FDATE,JDATE,JSCAN                              00000330
      COMMON/ONEONE/LAT,LON,RMAG,AZIM,ELEV,VMAG                         00000340
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00000350
     *            JGIDE2,JNOD2,JINS2,JREL3                              00000360
      COMMON/THREE/ A3,DV3, INC3, NODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00000370
     *              JGIDE3,JNOD3,JINS3                                  00000380
      COMMON/FOUR/A4,E4,INC4,NODE4,ARGP4,ANOM4                          00000390
      COMMON/ONECAN/TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1                00000400
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2,KREVS2,JUMB2,JPEN2                00000410
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3,KREVS3,JUMB3,JPEN3          00000420
      COMMON/FOURCA/FRAC4,TESSO4,ARC4,KCAN4,KREVS4,JUMB4,JPEN4          00000430
      COMMON/CODES/ OUTA(11), OUTB(11), OUTC(11), OUTD(11), OUTE(11),   00000440
     2              OUTF(11), OUTG(11), M(7), MPLOT, MDISK              00000450
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000460
      COMMON/DGREE3/ NOD2,DN2MAX,NOD3,DN3MAX,TH2,B2,TRUE1,TH3,B3,TRUE2  00000470
      DATA DUMMY1  /0.D0/                                               00000480
      ARG2P=ARGPI2                                                      00000490
      ARG3P=ARGPI3                                                      00000500
      READ (5,ORB)                                                      00000510
      CALL DEGRAD (1,I4,  NOD4,AOP4,TRUE4, INC4, NODE4,ARGP4,ANOM4)     00000520
      CALL DEGRAD (1,SNOD,FNOD,DNOD,DUMMY1,SNODE,FNODE,DNODE,DUMMY2)    00000530
      CALL DEGRAD (1,NLAT,ELON,AZ,  FPA,   LAT,  LON,  AZIM, ELEV)      00000540
      CALL DEGRAD (1,I2,NOD2,DN2MAX,ARG2P,INC2,NODE2,DNMAX2,ARGPI2)     00000550
      CALL DEGRAD(1,TH2,B2,TRUE1,DUMMY1,THETA2,BETA2,TA1,DUMMY2)        00000560
      CALL DEGRAD (1,I3,NOD3,DN3MAX,ARG3P,INC3,NODE3,DNMAX3,ARGPI3)     00000570
      CALL DEGRAD(1,TH3,B3,TRUE2,DUMMY1,THETA3,BETA3,TA2,DUMMY2)        00000580
C     CHECK FOR USER INPUT ERRORS                                       00000590
      IF ((JSCAN .NE. 1) .AND. (JSCAN .NE. 2)) GO TO 100                00000600
      IF ((JSCAN .EQ. 1) .AND. (DNODE .EQ. 0.D0)) DNODE=1.D4            00000610
      IF ((JSCAN .EQ. 2) .AND. (DTIME .EQ. 0.D0)) DTIME=1.D4            00000620
      RETURN                                                            00000630
  100 WRITE (6,1001) JSCAN                                              00000640
 1001 FORMAT (1H0,'INPUT4 FATAL ERROR. JSCAN=',I3,', BUT ONLY VALUES OF 00000650
     21 (NODE SCAN) OR 2 (TIME SCAN) ARE MEANINGFUL. CHECK NAMELIST INPU00000660
     3T.')                                                              00000670
      STOP                                                              00000680
      END                                                               00000690
C          DATA SET INPUT5     AT LEVEL 001 AS OF 12/06/78
      SUBROUTINE INPUT5                                                 00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C     SUBROUTINE INPUT5                                                 00000030
C                                                                       00000040
C                                                                       00000050
C                                                                       00000060
C     THE PURPOSES OF INPUT5 ARE TO READ THE NAMELIST INPUT (ORB) FOR A 00000070
C         MODE=5 RUN AND TO CONVERT ALL INPUT ANGLES FROM DEGREES       00000080
C         TO RADIANS.                                                   00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL INPUT AND     00000130
C         OUTPUT VARIABLES ARE PASSED THROUGH COMMON OR ARE READ IN     00000140
C         THROUGH THE NAMELIST ORB.                                     00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     INPUT5 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000190
C                                                                       00000200
C         MODE5                                                         00000210
C                                                                       00000220
C                                                                       00000230
C                                                                       00000240
C     THE FOLLOWING SUBROUTINE IS CALLED BY INPUT5.                     00000250
C                                                                       00000260
C         DEGRAD                                                        00000270
C                                                                       00000280
C                                                                       00000290
C                                                                       00000300
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000310
C                                                                       00000320
C         COMMON VARIABLES COMPUTED                                     00000330
C                                                                       00000340
C         ANOM1     ARGP1     INC1      NODE1                           00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C         COMMON VARIABLES USED AND COMPUTED                            00000390
C                                                                       00000400
C         A1        JDATE     KREVS1    MPLOT     OUTC(11)  OUTG(11)    00000410
C         ARC1      JPEN1     M(7)      MSUN      OUTD(11)  SDATE       00000420
C         E1        JUMB1     MDISK     OUTA(11)  OUTE(11)  TESSO1      00000430
C         FDATE     KCAN1(20) MORB      OUTB(11)  OUTF(11)  TIME        00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     THE FOLLOWING VARIABLES MAY BE READ IN THROUGH THE NAMELIST ORB-- 00000480
C                                                                       00000490
C         A1        I1        KREVS1    MSUN      OUTD(11)  SDATE       00000500
C         AOP1      JDATE     M(7)      NOD1      OUTE(11)  TESSO1      00000510
C         ARC1      JPEN1     MDISK     OUTA(11)  OUTF(11)  TIME        00000520
C         E1        JUMB1     MORB      OUTB(11)  OUTG(11)  TRUE1       00000530
C         FDATE     KCAN1(20) MPLOT     OUTC(11)                        00000540
C                                                                       00000550
C                                                                       00000560
C                                                                       00000570
      REAL*8 I1,INC1,NOD1,NODE1                                         00000580
      NAMELIST/ORB/A1,E1,I1,NOD1,AOP1,TRUE1,                            00000590
     2             SDATE,FDATE,JDATE,TIME,                              00000600
     3             TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1,                00000610
     4       MSUN,MORB,MOFLAG,OUTA,OUTB,OUTC,OUTD,OUTE,OUTF,OUTG,M,MPLOT00000620
     5  ,MDISK                                                          00000630
      COMMON/ONETWO/A1,E1,INC1,NODE1,ARGP1,ANOM1                        00000640
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000650
      COMMON/SCANS5/TIME,SDATE,FDATE,JDATE                              00000660
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000670
      COMMON/CODES/OUTA(11),OUTB(11),OUTC(11),OUTD(11),OUTE(11),        00000680
     2              OUTF(11),OUTG(11),M(7),MPLOT,MDISK                  00000690
      READ (5,ORB)                                                      00000700
      CALL DEGRAD(1,I1,NOD1,AOP1,TRUE1,INC1,NODE1,ARGP1,ANOM1)          00000710
      RETURN                                                            00000720
      END                                                               00000730
C          DATA SET INSERT     AT LEVEL 001 AS OF 11/07/78              00000000
      SUBROUTINE INSERT(JINS,JGIDE,JAPSIS,AA,EA,INCA,NODEA,ARGPA,ANOMA, 00000010
     2 R,AB,EB,INCB,NODEB,ARGPB,ANOMB,DVMAG,SB,TRGAOP,THETA,BETA,TA,    00000020
     3 JREL3)                                                           00000025
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000030
C                                                                       00000040
C                                                                       00000050
C                                                                       00000060
C     SUBROUTINE INSERT (JINS,JGIDE,JAPSIS,AA,EA,INCA,NODEA,ARGPA,ANOMA,00000070
C                        R,AB,EB,INCB,NODEB,ARGPB,ANOMB,DVMAG,SB,       00000080
C                        TRGAOP,THETA,BETA,TA,JREL3)                    00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     THE PURPOSE OF INSERT IS TO PERFORM ALL CALCULATIONS PURSUANT TO  00000130
C         AN ORBIT CHANGE MANEUVER. IT IS REQUIRED THAT THE INSERTION   00000140
C         POINT BE AN APSIS OF THE NEW ORBIT.                           00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000190
C                                                                       00000200
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000210
C                                                                       00000220
C          JINS      I*4      I      FLAG FOR CHOOSING BETWEEN THE TWO  00000230
C                                       POSSIBLE ORBIT-TO-ORBIT         00000240
C                                       INSERTION POINTS --             00000250
C                                                                       00000260
C                                       =+1, INSERT AT FIRST RELATIVE   00000270
C                                            NODE ENCOUNTERED           00000280
C                                       =+2, INSERT AT SECOND RELATIVE  00000290
C                                            NODE ENCOUNTERED           00000300
C                                       =-1, INSERT AT RELATIVE NODE    00000310
C                                            NEAREST TO APOGEE OF       00000320
C                                            OLD ORBIT                  00000330
C                                       =-2, INSERT AT RELATIVE NODE    00000340
C                                            NEAREST TO PERIGEE OF      00000350
C                                            OLD ORBIT                  00000360
C          JGIDE     I*4      I      FLAG FOR CHOOSING GUIDANCE OPTION--00000370
C                                                                       00000380
C                                       =+1, SPECIFY NEW ORBITAL PLANE  00000390
C                                              (GIVEN BY INCB, NODEB)   00000400
C                                              AND DVMAG.               00000410
C                                            COMPUTE POST-INSERTION     00000420
C                                              ORBITAL VELOCITY.        00000430
C                                            COMPUTE AB AND DELTAV.     00000440
C                                       =+2, SPECIFY NEW ORBITAL PLANE  00000450
C                                              (GIVEN BY INCB, NODEB)   00000460
C                                              AND AB.                  00000470
C                                            COMPUTE POST-INSERTION     00000480
C                                              ORBITAL VELOCITY.        00000490
C                                            COMPUTE DELTAV AND DVMAG.  00000500
C                                       =+3, TEMPORARILY SPECIFY NEW    00000510
C                                              ORBITAL PLANE (GIVEN BY  00000520
C                                              INCB, NODEB) AND AB.     00000530
C                                            THE POST-INSERTION ORBITAL 00000540
C                                              VELOCITY (VB) IS THUS    00000550
C                                              TEMPORARILY DETERMINED,  00000560
C                                              RESULTING IN A SPECIFIC  00000570
C                                              DIRECTION FOR DELTAV.    00000580
C                                            SPECIFY DVMAG - NOW DELTAV 00000590
C                                              IS FULLY DETERMINED.     00000600
C                                            RE-COMPUTE VB, AB, INCB,   00000610
C                                              AND NODEB.               00000620
C                                       =+4, INPUT THE MANEUVER POINT   00000630
C                                            (TA) AND THE DELTAV VECTOR 00000640
C                                            (DVMAG,THETA,BETA). COMPUTE00000650
C                                            THE NEW ORBITAL ELEMENTS   00000660
C          JAPSIS    I*4      O      FLAG INDICATING WHETHER INSERTION  00000670
C                                       POINT IS PERIGEE (-1) OR APOGEE 00000680
C                                       (+1) OF NEW ORBIT, OR WHETHER   00000690
C                                       NEW ORBIT IS A CIRCLE (0)       00000700
C          AA        R*8      I      SEMI-MAJOR AXIS OF OLD ORBIT (KM)  00000710
C          EA        R*8      I      ECCENTRICITY OF OLD ORBIT          00000720
C          INCA      R*8      I      INCLINATION OF OLD ORBIT (RADIANS) 00000730
C          NODEA     R*8      I      RIGHT ASCENSION OF ASCENDING NODE  00000740
C                                       OF OLD ORBIT (RADIANS)          00000750
C          ARGPA     R*8      I      ARGUMENT OF PERIGEE OF OLD ORBIT   00000760
C                                       (RADIANS)                       00000770
C          ANOMA     R*8      I      TRUE ANOMALY IN OLD ORBIT OF       00000780
C                                       INSERTION INTO OLD ORBIT        00000790
C                                       (RADIANS)                       00000800
C          R(3)      R*8     I/O     INPUT AS THE UNIT VECTOR POINTING  00000810
C                                       TO THE INSERTION POINT INTO THE 00000820
C                                       OLD ORBIT.                      00000830
C                                    OUTPUT AS THE UNIT VECTOR POINTING 00000840
C                                       TO THE INSERTION POINT INTO THE 00000850
C                                       NEW ORBIT.                      00000860
C          AB        R*8     I/O     SEMI-MAJOR AXIS OF NEW ORBIT (KM)  00000870
C          EB        R*8      O      ECCENTRICITY OF NEW ORBIT          00000880
C          INCB      R*8     I/O     INCLINATION OF NEW ORBIT (RADIANS) 00000890
C          NODEB     R*8     I/O     RIGHT ASCENSION OF ASCENDING NODE  00000900
C                                       OF NEW ORBIT (RADIANS)          00000910
C          ARGPB     R*8      O      ARGUMENT OF PERIGEE OF NEW ORBIT   00000920
C                                       (RADIANS)                       00000930
C          ANOMB     R*8      O      TRUE ANOMALY IN NEW ORBIT OF       00000940
C                                       INSERTION INTO NEW ORBIT (MUST  00000950
C                                       BE EITHER 0 OR PI RADIANS)      00000960
C          DVMAG     R*8     I/O     MAGNITUDE OF THE MANEUVER VELOCITY 00000970
C                                       VECTOR (KM/SEC)                 00000980
C          SB(30)    R*8      O      INSERTION PARAMETER OUTPUT ARRAY --00000990
C           (1)                         CENTRAL ANGLE IN OLD ORBIT      00001000
C                                         BETWEEN INSERTION AND LEAVE   00001010
C                                         POINTS (0 TO 360 DEGREES)     00001020
C           (2)                         MAGNITUDE OF INSERTION POINT    00001030
C                                         POSITION VECTOR INTO NEW      00001040
C                                         ORBIT (KM)                    00001050
C           (3)                         TRUE ANOMALY IN OLD ORBIT AT    00001060
C                                         WHICH INSERTION INTO NEW ORBIT00001070
C                                         OCCURS (DEGREES)              00001080
C           (4)                         TRAVERSAL TIME IN OLD ORBIT OF  00001090
C                                         ARC BETWEEN INSERTION AND     00001100
C                                         LEAVE POINTS, NOT INCLUDING   00001110
C                                         EXTRA REVOLUTIONS (MINUTES)   00001120
C          (5-10)                       VELOCITY VECTORS IMMEDIATELY    00001130
C                                         BEFORE AND AFTER THE MANEUVER 00001140
C                                         (KM/SEC)                      00001150
C          (11-13)                      MANEUVER VELOCITY VECTOR        00001160
C                                         (KM/SEC)                      00001170
C          (14)                         MAGNITUDE OF MANEUVER VELOCITY  00001180
C                                         VECTOR (SAME AS DVMAG)        00001190
C                                         (KM/SEC)                      00001200
C          (15-16)                      RIGHT ASCENSION, DECLINATION OF 00001210
C                                         MANEUVER VELOCITY VECTOR      00001220
C                                         (DEGREES)                     00001230
C          (17-18)                      RIGHT ASCENSION, DECLINATION OF 00001240
C                                         NEGATIVE OF MANEUVER VELOCITY 00001250
C                                         VECTOR (DEGREES)              00001260
C          (19-30)                      AVAILABLE FOR FUTURE OUTPUT     00001270
C                                         PARAMETERS                    00001280
C                                                                       00001290
C         TRGAOP     R*8      I      ARGUMENT OF PERIGEE OF NEW ORBIT,  00001300
C                                       IF POSITIVE (RADIANS).          00001310
C                                       IF TRGAOP IS NEGATIVE  THE      00001320
C                                       ARGUMENT OF PERIGEE OF THE NEW  00001330
C                                       ORBIT IS COMPUTED INTERNALLY.   00001340
C                                                                       00001350
C          TA        R*8      I      TRUE ANOMALY IN OLD ORBIT OF       00001360
C                                       INSERTION INTO NEW ORBIT.       00001370
C                                       (RADIANS)                       00001380
C          THETA     R*8      I      THE DECLINATION ANGLE FOR DELTAV   00001390
C                                       WITH RESPECT TO THE LOCAL       00001400
C                                       TAGNENT PLANE. IF THETA]0, THEN 00001410
C                                       DELTAV IS PERPENDICULAR TO THE  00001420
C                                       RADIUS VECTOR. IF THETA=+PI/2,  00001430
C                                       THEN DELTAV IS ALONG THE        00001440
C                                       POSITIVE RADIUS VECTOR.         00001450
C                                       (RADIANS)                       00001460
C          BETA      R*8      I      THE RIGHT ASCENSION ANGLE FOR      00001470
C                                       DELTAV MESAURED AS A RIGHT HAND 00001480
C                                       ROTATION ABOUT THE RADIUS VECTOR00001490
C                                       IN THE LOCAL TANGENT PLANE. BETA00001500
C                                       IS MEASURED FROM THE VECTOR     00001510
C                                       FORMED BY THE ANGULAR MOMENTUM  00001520
C                                       CROSSED WITH THE RADIUS VECTOR. 00001530
C                                       IF BETA=0, THEN THERE IS NO     00001540
C                                       PLANE CHANGE.  (RADIANS)        00001550
C          JREL3     I*4      I      DETERMINE ORBIT2 NODE BASED ON     00001551
C                                    LINE OF RELATIVE NODES BETWEEN     00001552
C                                    ORBIT 1&3 IF EQ TO 1               00001553
C                                                                       00001560
C     INSERT IS CALLED BY THE FOLLOWING SUBROUTINES.                    00001570
C                                                                       00001580
C         MODE DRIVERS                                                  00001590
C                                                                       00001600
C                                                                       00001610
C                                                                       00001620
C     THE FOLLOWING SUBROUTINES ARE CALLED BY INSERT.                   00001630
C                                                                       00001640
C         ANGMOM    ARGROT    DVEL      NODVEC                          00001650
C         ARCO      ARCTIM    ELMREC    RECEL                           00001660
C                                                                       00001670
C                                                                       00001680
C                                                                       00001690
C     INSERT NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00001700
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00001710
C                                                                       00001720
C                                                                       00001730
C                                                                       00001740
      REAL*8 INCA,INCB,NODEA,NODEB                                      00001750
      DIMENSION HA(3),HB(3),OB(3),R(3),RB(3),ELEM(6),X(3)               00001760
      DIMENSION VA(3),VB(3),DELTAV(3),SB(30)                            00001770
      DATA PI,U,DR/ 3.1415926535897932D0,398600.8D0,0.017453292519943D0/00001800
      DATA X,TWOPI/ 1.D0,0.D0,0.D0, 6.2831853071795864D0/               00001810
      ELEM(1)=AB                                                        00001811
      ELEM(2)=EB                                                        00001812
      ELEM(3)=INCB                                                      00001813
      ELEM(4)=NODEB                                                     00001814
      ELEM(5)=ARGPB                                                     00001815
      ELEM(6)=ANOMB                                                     00001816
C                                                                       00001820
C*****ANGULAR MOMENTUM, ASCENDING NODE UNIT VECTORS                     00001830
      CALL ANGMOM(INCA,NODEA,HA)                                        00001840
      IF(JREL3.NE.0) CALL NODE(INCA,NODEA,ELEM(3),ELEM(4))              00001845
      CALL ANGMOM(ELEM(3),ELEM(4),HB)                                   00001850
      CALL NODVEC (HB(1),HB(2),OB)                                      00001860
      IF(JGIDE .EQ. 4) GO TO 15                                         00001870
C                                                                       00001880
C*****CALCULATE INSERTION POINT POSITION VECTOR & ITS TRUE ANOMALY IN   00001890
C     THE OLD ORBIT.                                                    00001900
      CALL ARCO (JINS,HA,HB,AA,EA,ANOMA,ANOM,PHI,R,RINS)                00001910
   15 IF(JGIDE .NE. 4) GO TO 20                                         00001920
      ANOM = TA                                                         00001930
      PHI = ANOM - ANOMA                                                00001940
      IF(PHI .LT. 0.D0) PHI=PHI+TWOPI                                   00001950
C                                                                       00001960
C     CONVERT INITIAL ORBITAL ELEMENTS TO CARTESIAN STATE               00001970
C                                                                       00001980
      CALL ELMREC(AA,EA,INCA,NODEA,ARGPA,TA,VA,VM,2,RB,RINS)            00001990
      R(1) = RB(1)/RINS                                                 00002000
      R(2) = RB(2)/RINS                                                 00002010
      R(3) = RB(3)/RINS                                                 00002020
      CALL DVEL(JGIDE,ELEM(1),DVMAG,DELTAV,RAV,DECV,RAOPP,DECOPP,HB,    00002030
     * R,RINS,VA,VB,THETA,BETA,HA)                                      00002040
      CALL RECEL(U,RB,VB,TFP,ELEM,XM)                                   00002050
      DO 18 J=3,6                                                       00002060
   18 ELEM(J) = DR*ELEM(J)                                              00002070
   20 CONTINUE                                                          00002080
C                                                                       00002090
C*****CALCULATE TIME SATELLITE SPENDS IN OLD ORBITAL ARC.               00002100
      CALL ARCTIM (AA,EA,ANOMA,TFP)                                     00002110
      CALL ARCTIM (AA,EA,ANOM,THYME)                                    00002120
      IF (ANOM-ANOMA .LT. 0.D0) THYME = THYME + TWOPI/DSQRT(U/AA**3.)   00002130
      STAY = (THYME - TFP)/60.D0                                        00002140
      IF(JGIDE .EQ. 4) GO TO 100                                        00002150
C                                                                       00002160
C*****CALCULATE MANEUVER DELTAV AND SATELLITE ATTITUDE.                 00002170
      CALL ELMREC (AA,EA,INCA,NODEA,ARGPA,ANOM,VA,SB(1),0,RB,SB(2))     00002180
      CALL DVEL(JGIDE,ELEM(1),DVMAG,DELTAV,RAV,DECV,RAOPP,DECOPP,       00002190
     2           HB,R,RINS,VA,VB)                                       00002200
C                                                                       00002210
C*****JGIDE=3 OPTION RESULTS IN DIFFERENT ORBIT THAN THE INPUT AB, INCB,00002220
C     AND NODEB WOULD HAVE YIELDED.                                     00002230
      IF (JGIDE .NE. 3) GO TO 35                                        00002240
      DO 25 J=1,3                                                       00002250
   25 RB(J)  =  RINS*R(J)                                               00002260
      CALL RECEL (U,RB,VB,TFP,ELEM,SB(1))                               00002270
      IF (RINS.GE. 2.D0*ELEM(1)) GO TO 200                              00002280
C     RECEL'S ANGLES ARE IN DEGREES. CONVERT TO RADIANS FOR CALLING SEQ.00002290
C     IF REQUIRED, CHANGE THE ARGUMENT OF PERIGEE.                      00002300
      IF (TRGAOP) 5,6,6                                                 00002310
    6 AOPDIF=TRGAOP/DR-ELEM(5)                                          00002320
      ELEM(5)=TRGAOP/DR                                                 00002330
      ELEM(6)=ELEM(6)-AOPDIF/DR                                         00002340
      IF (ELEM(6)) 7,5,5                                                00002350
    7 ELEM(6)=ELEM(6)+360.D0                                            00002360
    5 DO 30 J=3,6                                                       00002370
   30 ELEM(J)=DR*ELEM(J)                                                00002380
      IF (RINS-ELEM(1)) 58,68,63                                        00002390
   35 IF(RINS .GE. 2.D0*ELEM(1)) GO TO 200                              00002400
C                                                                       00002410
C*****DEPENDING ON THE INCLINATION, FIND THE ANGLE IN THE NEW ORBIT     00002420
C     EITHER FROM THE X VECTOR OR FROM THE ASCENDING NODE UNIT VECTOR   00002430
C     TO THE INSERTION POINT POSITION VECTOR.                           00002440
      IF (ELEM(3) .NE. 0.D0) CALL ARGROT (OB,R,HB,ELEM(5))              00002450
      IF (ELEM(3) .EQ. 0.D0) CALL ARGROT (X, R,HB,ELEM(5))              00002460
C                                                                       00002470
C*****DETERMINE IF INSERTION PT. IS APOGEE (I.E. RINS = APOGEE RADIUS), 00002480
C     PERIGEE (RINS = PERIGEE RADIUS), OR IF NEW ORBIT IS A CIRCLE.     00002490
      IF (RINS-ELEM(1)) 55,65,60                                        00002500
C                                                                       00002510
C*****INS. PT. IS PERIGEE OF NEW ORBIT                                  00002520
   55 ELEM(2) = 1.D0 - RINS/ELEM(1)                                     00002530
      ELEM(6) = 0.D0                                                    00002540
   58 JAPSIS= -1                                                        00002550
      GO TO 90                                                          00002560
C                                                                       00002570
C*****INS. PT. IS APOGEE OF NEW ORBIT                                   00002580
   60 ELEM(2) = RINS/ELEM(1) - 1.D0                                     00002590
      ELEM(5) = ELEM(5) + PI                                            00002600
      IF (ELEM(5) .GE. TWOPI) ELEM(5) = ELEM(5) - TWOPI                 00002610
      ELEM(6) = PI                                                      00002620
   63 JAPSIS = +1                                                       00002630
      GO TO 90                                                          00002640
C                                                                       00002650
C*****NEW ORBIT IS CIRCLE                                               00002660
   65 ELEM(2) = 0.D0                                                    00002670
      ELEM(6) = ELEM(5)                                                 00002680
      ELEM(5) = 0.D0                                                    00002690
   68 JAPSIS= 0                                                         00002700
C                                                                       00002710
C*****IF REQUIRED, CHANGE THE ARGUMENT OF PERIGEE.                      00002720
   90 IF (JGIDE-3) 92,100,92                                            00002730
   92 IF (TRGAOP) 100,93,93                                             00002740
   93 ELEM(6)=ELEM(6)-TRGAOP+ELEM(5)                                    00002750
      ELEM(5)=TRGAOP                                                    00002760
C                                                                       00002770
C*****FILL UP OUTPUT ARRAY                                              00002780
  100 SB(1)=PHI/DR                                                      00002790
      SB(2)  = RINS                                                     00002800
      SB(3)  = ANOM/DR                                                  00002810
      SB(4)  = STAY                                                     00002820
      DO 91 J=1,3                                                       00002830
      SB(4+J)= VA(J)                                                    00002840
      SB(7+J)= VB(J)                                                    00002850
   91 SB(10+J)=DELTAV(J)                                                00002860
      SB(14) = DVMAG                                                    00002870
      SB(15) = RAV                                                      00002880
      SB(16) = DECV                                                     00002890
      SB(17) = RAOPP                                                    00002900
      SB(18) = DECOPP                                                   00002910
      AB=ELEM(1)                                                        00002911
      EB=ELEM(2)                                                        00002912
      INCB=ELEM(3)                                                      00002913
      NODEB=ELEM(4)                                                     00002914
      ARGPB=ELEM(5)                                                     00002915
      ANOMB=ELEM(6)                                                     00002916
      RETURN                                                            00002920
C                                                                       00002930
  200 WRITE(6,1000) RINS,ELEM(1)                                        00002940
 1000 FORMAT   (1H0, 'FATAL MESSAGE FROM INSERT. INSERTION VECTOR MAGNIT00002950
     2UDE EXCEEDS MAJOR AXIS OF NEW ORBIT -- I.E. RINS .GE. 2.*AB.' / ' 00002960
     3        RINS=',D17.10,5X,'AB=',D17.10, 10X, 'THEREFORE NO INSERTIO00002970
     4N COULD TAKE PLACE AT CHOSEN POINT.')                             00002980
      STOP                                                              00002990
      END                                                               00003000
C          DATA SET JOHANN     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE JOHANN(ECC,XM,TOL,TA,K)                                00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
      DATA RAD/57.29577951308232D0/                                     00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE JOHANN (ECC,XM,TOL,TA,K)                               00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF JOHANN IS TO CONVERT MEAN ANOMALY TO TRUE ANOMALY  00000100
C         FOR ELLIPTIC AND HYPERBOLIC ORBITS.                           00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT    TYPE   I/O        DEFINITION                      00000170
C                                                                       00000180
C          ECC        R*8     I      ECCENTRICITY                       00000190
C          XM         R*8     I      HYPERBOLIC OR ELLIPTIC MEAN ANOMALY00000200
C                                       (DEGREES)                       00000210
C          TOL        R*8     I      TOLERANCE USED TO DETERMINE THE    00000220
C                                       ACCURACY OF THE SOLUTION        00000230
C          TA         R*8     O      TRUE ANOMALY (DEGREES)             00000240
C          K          I*4     O      NUMBER OF ITERATIONS NEEDED FOR THE00000250
C                                       SOLUTION                        00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     JOHANN IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000300
C                                                                       00000310
C         SEP       SUNOCO                                              00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     NO SUBROUTINES ARE CALLED BY JOHANN.                              00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     JOHANN NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000400
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000410
C                                                                       00000420
C                                                                       00000430
C                                                                       00000440
      RM=DMOD(XM,360.D0)/RAD                                            00000450
      K=0                                                               00000460
      IF(ECC.GT.1.D0) GO TO 4                                           00000470
C                                                                       00000480
C********ELLIPTIC ORBIT                                                 00000490
C                                                                       00000500
      E2=RM+ECC*DSIN(RM)                                                00000510
    1 K=K+1                                                             00000520
      E1=E2-(E2-ECC*DSIN(E2)-RM)/(1.D0-ECC*DCOS(E2))                    00000530
      IF(DABS(E2-E1).LT.TOL) GO TO 2                                    00000540
      K=K+1                                                             00000550
      E2=E1-(E1-ECC*DSIN(E1)-RM)/(1.D0-ECC*DCOS(E1))                    00000560
      IF(DABS(E1-E2).LT.TOL) GO TO 3                                    00000570
      GO TO 1                                                           00000580
    2 E2=E1                                                             00000590
    3 E=E2                                                              00000600
      IF(E.LT.0.D0) E=E+360.D0/RAD                                      00000610
      C=DABS(E*RAD-180.D0)                                              00000620
      IF(C.LT.1.D-08) GO TO 8                                           00000630
      F=DSQRT((1.D0+ECC)/(1.D0-ECC))                                    00000640
      G=DTAN(E/2.D0)                                                    00000650
      TA=2.D0*DATAN(F*G)*RAD                                            00000660
      GO TO 9                                                           00000670
    8 TA=E*RAD                                                          00000680
    9 IF(TA.LT.0.D0) TA=TA+360.D0                                       00000690
      GO TO 10                                                          00000700
C                                                                       00000710
C********HYPERBOLIC ORBIT                                               00000720
C                                                                       00000730
    4 IF(RM.GT.180.D0/RAD) RM=RM-360.D0/RAD                             00000740
      F2=ECC*DSINH(RM)-RM                                               00000750
    5 K=K+1                                                             00000760
      F1=F2-(ECC*DSINH(F2)-F2-RM)/(ECC*DCOSH(F2)-1.D0)                  00000770
      IF(DABS(F2-F1).LT.TOL) GO TO 6                                    00000780
      K=K+1                                                             00000790
      F2=F1-(ECC*DSINH(F1)-F1-RM)/(ECC*DCOSH(F1)-1.D0)                  00000800
      IF(DABS(F1-F2).LT.TOL) GO TO 7                                    00000810
      GO TO 5                                                           00000820
    6 F2=F1                                                             00000830
    7 F=F2                                                              00000840
      E=DSQRT((ECC+1.D0)/(ECC-1.D0))                                    00000850
      G=DTANH(F/2.D0)                                                   00000860
      TA=2.D0*DATAN(E*G)*RAD                                            00000870
      IF(TA.LT.0.D0) TA=TA+360.D0                                       00000880
   10 RETURN                                                            00000890
      END                                                               00000900
C          DATA SET LATIME     AT LEVEL 002 AS OF 12/20/78
      SUBROUTINE LATIME(JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)        00001
      IMPLICIT REAL*8(A-H,O-Z)                                          00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE LATIME (JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)       00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF LATIME IS TO COMPUTE EITHER THE LAUNCH TIME OR THE 00009
C         ASCENDING NODE OF THE INITIAL ORBIT OF A MISSION SEQUENCE FOR 00010
C         ANY GIVEN LAUNCH DATE. LATIME ALSO COMPUTES THE TIME OF       00011
C         ORBITAL INJECTION AND THE HOUR ANGLE OF THE GREENWICH         00012
C         MERIDIAN AT THAT TIME.                                        00013
C                                                                       00014
C                                                                       00015
C                                                                       00016
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00017
C                                                                       00018
C         ARGUMENT   TYPE    I/O        DEFINITION                      00019
C                                                                       00020
C          JSCAN     I*4      I      OPTION FLAG --                     00021
C                                       =1, COMPUTE LAUNCH TIME FROM    00022
C                                           NODE                        00023
C                                       =2, COMPUTE NODE FROM LAUNCH    00024
C                                           TIME                        00025
C          TLINJ     R*8      I      TIME BETWEEN LAUNCH AND ORBITAL    00026
C                                       INJECTION (SECONDS)             00027
C          OMEGA     R*8      I      GEOGRAPHIC LONGITUDE OF ASCENDING  00028
C                                       NODE WITH RESPECT TO GREENWICH  00029
C                                       (ANGLE FIXED BY THE ORBIT       00030
C                                       GEOMETRY) (RADIANS)             00031
C          DAY       R*8      I      LAUNCH DAY, IN DAYS SINCE 1950.0   00032
C          NODE      R*8     I/O     RIGHT ASCENSION OF THE ASCENDING   00033
C                                       NODE (RADIANS)                  00034
C          GMTL      R*8     I/O     GREENWICH MEAN TIME OF LAUNCH      00035
C                                       (HOURS)                         00036
C          TIME      R*8      O      TIME OF ORBITAL INJECTION (HOURS)  00037
C                                       (MAY BE GREATER THAN 24)        00038
C          HA        R*8      O      HOUR ANGLE OF GREENWICH MERIDIAN AT00039
C                                       INJECTION TIME (RADIANS)        00040
C                                                                       00041
C                                                                       00042
C                                                                       00043
C     LATIME IS CALLED BY THE FOLLOWING SUBROUTINES.                    00044
C                                                                       00045
C         MODE DRIVERS                                                  00046
C                                                                       00047
C                                                                       00048
C                                                                       00049
C     THE FOLLOWING SUBROUTINE IS CALLED BY LATIME.                     00050
C                                                                       00051
C         EHA                                                           00052
C                                                                       00053
C                                                                       00054
C                                                                       00055
C     LATIME NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00056
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00057
C                                                                       00058
C                                                                       00059
      REAL*8 NODE                                                       00060
      DATA SIDDAY,TWOPI,SEC/23.93446959444D0,6.2831853071795864D0,3.6D3/00061
C***GREENWICH R.A. AT 0 GMT ON LAUNCH DAY                               00062
      CALL EHA(DAY,0.D0,0.D0,GRA,GEOROT)                                00063
C***CALCULATE INJECTION TIME                                            00064
      IF(JSCAN .EQ. 2) GO TO 40                                         00065
      TIME = (NODE-OMEGA-GRA) / (GEOROT*SEC)                            00066
C***LAUNCH TIME                                                         00067
      GMTL = TIME - TLINJ/SEC                                           00068
C***IF GMTL .LT. 0 ADD SIDEREAL DAY TO IT, IF GMTL .GE. 24, SUBTRACT.   00069
      IF (GMTL) 30,60,25                                                00070
   25 IF(GMTL-24.D0) 60,35,35                                           00071
   30 GMTL = GMTL+SIDDAY                                                00072
      TIME = TIME + SIDDAY                                              00073
      IF (GMTL .LT. 0.D0) GO TO 30                                      00074
      GO TO 60                                                          00075
   35 GMTL = GMTL - SIDDAY                                              00076
      TIME = TIME-SIDDAY                                                00077
      GO TO 60                                                          00078
C                                                                       00079
C***CALCULATE INJECTION TIME                                            00080
  40  TIME = GMTL + TLINJ/SEC                                           00081
C***CALCULATE NODE                                                      00082
      NODE = GRA + OMEGA + TIME*SEC*GEOROT                              00083
C***IF NODE .LT. TWOPI ADD TWOPI, IF NODE .GT. TWOPI SUBTRACT TWOPI.    00084
      IF(NODE) 50,60,45                                                 00085
   45 IF(NODE-TWOPI) 60,55,55                                           00086
  50  NODE = NODE + TWOPI                                               00087
      GO TO 60                                                          00088
   55 NODE = NODE - TWOPI                                               00089
C***GREENWICH HOUR ANGLE                                                00090
   60 HA = NODE - OMEGA                                                 00091
      RETURN                                                            00092
      END                                                               00093
C          DATA SET LAUCON     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE LAUCON(MODE,M,JSDAY,DAY,TIME,STAY,A,E,INC,NODE,ARGP,   00000010
     2  ANOMA,P,TPASS,DELV,TESSO,ARC,KCAN,KREVS,JUMB,JPEN,SC,S,N)       00000020
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE LAUCON (MODE,M,JSDAY,DAY,TIME,STAY,A,E,INC,NODE,ARGP,  00000060
C                        ANOMA,P,TPASS,DELV,TESSO,ARC,KCAN,KREVS,JUMB,  00000070
C                        JPEN,SC)                                       00000080
C                                                                       00000090
C                                                                       00000100
C                                                                       00000110
C     THE PURPOSES OF LAUCON ARE--                                      00000120
C                                                                       00000130
C          (1) TO COMPUTE AUXILIARY QUANTITIES NEEDED FOR LAUNCH CON-   00000140
C              STRAINT PARAMETER ANALYSIS.                              00000150
C          (2) TO CALL THE ROUTINES WHICH ACTUALLY PERFORM EACH TYPE OF 00000160
C              CONSTRAINED-PARAMETER ANALYSIS.                          00000170
C                                                                       00000180
C                                                                       00000190
C                                                                       00000200
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000210
C                                                                       00000220
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000230
C                                                                       00000240
C          MODE      I*4      I      PROGRAM OPERATING MODE             00000250
C          M         I*4      I      NUMBER DENOTING THE ORBIT OF THE   00000260
C                                       MISSION SEQUENCE FOR WHICH      00000270
C                                       CONSTRAINT ANALYSIS IS DESIRED  00000280
C          JSDAY     I*4      I      NUMBER OF WHOLE DAYS SINCE 1950.0  00000290
C                                       TO FIRST DAY IN LAUNCH DATE     00000300
C                                       SCAN (INTEGER)                  00000310
C          DAY       R*8     I/O     INPUT AS NUMBER OF WHOLE DAYS SINCE00000320
C                                       1950.0 TO DAY ON WHICH SATELLITE00000330
C                                       IS INSERTED INTO THIS ORBIT.    00000340
C                                    OUTPUT AS NUMBER OF WHOLE DAYS     00000350
C                                       SINCE 1950.0 TO DAY ON WHICH    00000360
C                                       SATELLITE LEAVES THIS ORBIT     00000370
C                                       (I.E. IS INSERTED INTO NEXT     00000380
C                                       ORBIT), TAKING INTO ACCOUNT     00000390
C                                       KREVS.                          00000400
C          TIME      R*8     I/O     INPUT AS TIME (IN HRS) OF INSERTION00000410
C                                       INTO THIS ORBIT.                00000420
C                                    OUTPUT AS TIME (IN HRS) AT WHICH   00000430
C                                       SATELLITE LEAVES THIS ORBIT     00000440
C                                       (I.E. IS INSERTED INTO NEXT     00000450
C                                       ORBIT), TAKING INTO ACCOUNT     00000460
C                                       KREVS.                          00000470
C          STAY      R*8      I      TOTAL TIME SPENT ALONG THE ARC     00000480
C                                       BETWEEN INSERTION POINTS (NOT   00000490
C                                       INCLUDING ADDITIONAL COMPLETE   00000500
C                                       REVOLUTIONS) (MINUTES)          00000510
C          A         R*8      I      SEMI-MAJOR AXIS (KM)               00000520
C          E         R*8      I      ECCENTRICITY                       00000530
C          INC       R*8      I      INCLINATION (RADIANS)              00000540
C          NODE      R*8      I      RIGHT ASCENSION OF ASCENDING       00000550
C                                       NODE (RADIANS)                  00000560
C          ARGP      R*8      I      ABGUMENT OF PERIGEE (RADIANS)      00000570
C          ANOMA     R*8      I      TRUE ANOMALY IN THIS ORBIT OF      00000580
C                                       INSERTION POINT INTO THIS ORBIT 00000590
C                                       (RADIANS)                       00000600
C          P         R*8      O      PERIOD OF THE ORBIT (MINUTES)      00000610
C          TPASS     R*8     I/O     INPUT AS TIME (IN DAYS SINCE       00000620
C                                       1950.0) AT WHICH SATELLITE WOULD00000630
C                                       HAVE LEFT THE PREVIOUS ORBIT HAD00000640
C                                       KREVS FOR THAT ORBIT BEEN ZERO. 00000650
C                                       (IN REALITY, KREVS MAY OR MAY   00000660
C                                       NOT HAVE BEEN ZERO).            00000670
C                                    OUTPUT AS THE SAME THING FOR THE   00000680
C                                       CURRENT ORBIT.                  00000690
C          DELV(3)   R*8      I      (+) OR (-) SATELLITE SPIN AXIS     00000700
C                                       AT INSERTION INTO THIS ORBIT    00000710
C                                       (OFTEN THE INSERTION MANEUVER   00000720
C                                       VELOCITY VECTOR).               00000730
C          TESSO     R*8      I      TIME AT WHICH ARC TO BE CONSIDERED 00000740
C                                       IN ANALYZING EARTH-SUN          00000750
C                                       SEPARATION ANGLE BEGINS         00000760
C                                       (SECONDS SINCE PERIGEE PASSAGE).00000770
C          ARC       R*8      I      TIME FRACTION (.LE. 1.D0) OF A FULL00000780
C                                       REVOLUTION (REFERENCED FROM     00000790
C                                       INSERTION) CORRESPONDING TO THE 00000800
C                                       ARC FOR WHICH SHADOW TIMES ARE  00000810
C                                       DESIRED.                        00000820
C                                    NOTE --IF SHADOW TIMES ARE DESIRED 00000830
C                                          FOR THE FRACTIONAL ARC (NOT  00000840
C                                          INCLUDING FULL REVOLUTIONS)  00000850
C                                          BETWEEN INSERTION AND LEAVE  00000860
C                                          POINTS, INPUT ARC AS 0.D0.   00000870
C          KCAN(20)  I*4      I      ARRAY OF 20 FLAGS SIGNALING WHICH  00000880
C                                       CONSTRAINT ANALYSES ARE TO BE   00000890
C                                       DONE. EACH FLAG IS SET EITHER TO00000900
C                                       ZERO (NO ANALYSIS OF THIS       00000910
C                                       CONSTRAINT) OR 1 (CARRY OUT     00000920
C                                       ANALYSIS). THE FOLLOWING        00000930
C                                       ANALYSES ARE FLAGGED --         00000940
C           (1)                            SHADOW TIMES                 00000950
C           (2)                            SOLAR ASPECT ANGLES AT       00000960
C                                             INSERTION                 00000970
C           (3)                            EARTH-SATELLITE-SUN ANGLES   00000980
C           (4)                            ANGLE BETWEEN SUN VECTOR AND 00000990
C                                             (+ OR -) SATELLITE        00001000
C                                             VELOCITY VECTOR AT LEAVE  00001010
C                                             POINT IN ORBIT            00001020
C           (5)                            EARTH ASPECT ANGLES AT APOGEE00001030
C                                             AND PERIGEE               00001040
C          (6-20)                          AVAILABLE FOR NEW ANALYSES   00001050
C          KREVS     I*4      I      NUMBER OF ADDITIONAL COMPLETE      00001060
C                                       REVOLUTIONS DESIRED BEFORE      00001070
C                                       LEAVING THIS ORBIT              00001080
C          JUMB,JPEN I*4      I      SHADOW INPUT FLAGS --              00001090
C                                       .EQ.0, NO UMBRAL, PENUMBRAL     00001100
C                                           BOUNDARIES DESIRED          00001110
C                                       .NE.0, BOUNDARIES DESIRED       00001120
C          SC(50)    R*8      O      CONTAINS 50 OUTPUT PARAMETERS      00001130
C                                       CHOSEN ACCORDING TO THE INPUT   00001140
C                                       VALUES OF MODE AND M. (OUTPUT   00001150
C                                       PARAMETERS ARE DESCRIBED IN THE 00001160
C                                       SUBROUTINES WHICH CALCULATE     00001170
C                                       THEM.) SC ARRAY IS FILLED IN AT 00001180
C                                       THE END OF LAUCON.              00001190
C          S(N)      R*8     I/O     ARRAY CONTAINING THE VALUES OF ALL 00001200
C                                       N POSSIBLE OUTPUT PARAMETERS.   00001210
C          N         I*4      I      TOTAL NUMBER OF OUTPUT PARAMETERS  00001220
C                                       FROM WHICH USER CAN CHOOSE      00001230
C                                       (DEPENDS ON MODE)               00001240
C                                                                       00001250
C                                                                       00001260
C                                                                       00001270
C     LAUCON IS CALLED BY THE FOLLOWING SUBROUTINES.                    00001280
C                                                                       00001290
C         MODE DRIVERS                                                  00001300
C                                                                       00001310
C                                                                       00001320
C                                                                       00001330
C     THE FOLLOWING SUBROUTINES ARE CALLED BY LAUCON.                   00001340
C                                                                       00001350
C         ESSO      OFSHOR    SUNVEC    VERTEX                          00001360
C         MEANOM    SUNOCO    TFRAC                                     00001370
C                                                                       00001380
C                                                                       00001390
C                                                                       00001400
C     LAUCON NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00001410
C          ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.        00001420
C                                                                       00001430
C                                                                       00001440
C                                                                       00001450
      REAL*8 INC,NODE                                                   00001460
      DIMENSION KCAN(20),SOL(3),APOLLO(3),SHINE(3),HELIOS(3),DELV(3)    00001470
      DIMENSION R(3), V(3), S(N)                                        00001480
      DIMENSION SC(50),PEN(5),UMB(5),EXXON(4),ENCO(4)                   00001490
      DATA TWOPI,DS,SIXTY,U/6.283185307179586D0,8.64D4,60.D0,398600.8D0/00001500
      JJUMB=JUMB                                                        00001510
      JJPEN=JPEN                                                        00001520
C*****CALCULATE SOME FREQUENTLY-USED QUANTITIES.                        00001530
C     TINS IS REAL TIME (IN SECS SINCE 1950.0) AT WHICH SATELLITE IS    00001540
C          INSERTED INTO THIS ORBIT.                                    00001550
C     AMEAN IS MEAN ANOMALY AT THAT TIME.                               00001560
C     PERIOD (IN SECONDS) AND P (IN MINUTES) ARE THE ORBITAL PERIOD.    00001570
      TINS   = DAY*DS + TIME * SIXTY**2                                 00001580
      CALL MEANOM(E,ANOMA,EANOMA,AMEAN)                                 00001590
      PERIOD = TWOPI * DSQRT((A**3.)/U)                                 00001600
      P      = PERIOD/SIXTY                                             00001610
C     TLEAVE IS REAL TIME (IN DAYS SINCE 1950.0) AT WHICH SATELLITE     00001620
C            LEAVES THIS ORBIT -- I.E. REAL TIME OF INSERTION INTO NEXT 00001630
C            ORBIT--TAKING INTO ACCOUNT THE DESIRED NO. OF FULL REVS.   00001640
      TZERO  = (TINS + STAY*SIXTY)/DS                                   00001650
      TLEAVE = TZERO + KREVS*PERIOD/DS                                  00001660
C*****OBTAIN SUN'S POSITION --                                          00001670
C       (SOL)    AT NEAREST HALF-DAY TO ACTUAL DATE & TIME OF INSERTION,00001680
C       (APOLLO) AT NEAREST HALF-DAY TO INPUT VALUE OF 'TPASS',         00001690
C       (SHINE)  AT NEAREST HALF-DAY TO OUTPUT VALUE OF 'TPASS',        00001700
C       (HELIOS) AT NEAREST HALF-DAY TO ACTUAL DATE & TIME OF LEAVING.  00001710
      CALL SUNVEC (JSDAY,DAY,TIME,   SOL)                               00001720
      CALL TFRAC (TPASS,0.D0,DAY,T)                                     00001730
      CALL SUNVEC (JSDAY,DAY,T*24.D0,APOLLO)                            00001740
      CALL TFRAC (TZERO,0.D0,DAY,T)                                     00001750
      CALL SUNVEC (JSDAY,DAY,T*24.D0,SHINE)                             00001760
      CALL TFRAC (TLEAVE,0.D0,DAY,T)                                    00001770
      TIME = T * 24.D0                                                  00001780
      CALL SUNVEC (JSDAY,DAY,TIME,   HELIOS)                            00001790
      TPASS= TZERO                                                      00001800
C                                                                       00001810
C                                                                       00001820
C*****BEGIN LAUNCH CONSTRAINTS*****                                     00001830
C*****SHADOW CALCULATION.                                               00001840
      IF (KCAN(1) .EQ. 0) GO TO 200                                     00001850
C     TARC IS TIME (IN MINUTES, IN 1ST REVOLUTION) SATELLITE SPENDS IN  00001860
C          THE ARC FOR WHICH SHADOW COMPUTATIONS ARE DESIRED.           00001870
      TARC   = ARC * P                                                  00001880
      IF (ARC .EQ. 0.D0) TARC = STAY                                    00001890
      CALL OFSHOR (A,E,INC,NODE,ARGP,AMEAN,P,TARC,SOL,JPEN,JUMB,PEN,UMB)00001900
      JUMB=JJUMB                                                        00001910
      JPEN=JJPEN                                                        00001920
C*****SOLAR ASPECT ANGLES ARE CALCULATED USING SPIN AXIS AT INSERTION.  00001930
  200 IF (KCAN(2) .EQ. 0) GO TO 300                                     00001940
      CALL VERTEX (SOL,DELV,ASP,ASPN)                                   00001950
      CALL VERTEX (APOLLO,DELV,ASPR1,ASPNR1)                            00001960
C*****EARTH-SATELLITE-SUN ANGLES ARE CALCULATED DURING FIRST AND LAST   00001970
C     REVOLUTIONS OF ANY GIVEN ORBIT.                                   00001980
  300 IF (KCAN(3) .EQ. 0) GO TO 400                                     00001990
      CALL ESSO (A,E,INC,NODE,ARGP,PERIOD,TESSO,SHINE,ENCO)             00002000
      CALL ESSO (A,E,INC,NODE,ARGP,PERIOD,TESSO,HELIOS,EXXON)           00002010
C*****ANGLE BETWEEN SUN & SAT. VELOCITY VECTOR AT LEAVE PT. IN ORBIT.   00002020
  400 IF (KCAN(4) .EQ. 0) GO TO 500                                     00002030
      CALL SUNOCO (HELIOS,A,E,INC,NODE,ARGP,ANOMA,STAY,P,ASPDEP,ASNDEP) 00002040
C*****ANGLE BETWEEN EARTH AND SATELLITE SPIN AXIS, AT APOGEE & PERIGEE  00002050
  500 IF (KCAN(5) .EQ. 0) GO TO 600                                     00002060
      CALL ELMREC (A,E,INC,NODE,ARGP,0.D0,V,VMAG,1,R,RMAG)              00002070
      CALL VERTEX (R,DELV,APOGEO,PERGEO)                                00002080
C***** NEW ANALYSES GO HERE.                                            00002090
  600 CONTINUE                                                          00002100
C                                                                       00002110
C                                                                       00002120
C*****FILL IN OUTPUT ARRAY. (MODE- AND ORBIT-DEPENDENT)*****************00002130
      GO TO (1000,2000,3000,4000,5000                         ),MODE    00002140
      WRITE (6,9000) MODE                                               00002150
C                                                                       00002160
C*****LAUCON OUTPUT FOR MODE=1 ***                                      00002170
 1000 DO 1005 K=1,5                                                     00002180
      SC(K)    =    PEN(K)                                              00002190
 1005 SC(5+K)  =    UMB(K)                                              00002200
      DO 1010 K=1,4                                                     00002210
 1010 SC(10+K) =    EXXON(K)                                            00002220
      RETURN                                                            00002230
C                                                                       00002240
C                                                                       00002250
C*****LAUCON OUTPUT FOR MODE=2 ***                                      00002260
 2000 DO 2010 K=1,5                                                     00002270
      SC(K)    =    PEN(K)                                              00002280
 2010 SC(5+K)  =    UMB(K)                                              00002290
      DO 2014 K=1,4                                                     00002300
 2014 SC(10+K) =    EXXON(K)                                            00002310
      GO TO (2100,2200),M                                               00002320
C     ORBIT 1 ONLY                                                      00002330
 2100 NDXU=0                                                            00002340
      NDXP=0                                                            00002350
      CALL DRILL (NDXU,NDXP,KCAN,TARC,JJPEN,JJUMB,PEN,UMB)              00002360
      RETURN                                                            00002370
C     ORBIT 2 ONLY                                                      00002380
 2200 DO 2218 K=1,4                                                     00002390
 2218 SC(14+K) =    ENCO(K)                                             00002400
      SC(19)   =    ASP                                                 00002410
      SC(20)   =    ASPR1                                               00002420
      SC(21)   =    APOGEO                                              00002430
      SC(22)   =    PERGEO                                              00002440
      SC(23)=0.D0                                                       00002450
      SC(24)=0.D0                                                       00002460
      IF (NDXP.NE.0.AND.PEN(1).EQ.0.D0.AND.PEN(2).NE.0.D0)              00002470
     *   SC(23)=S(NDXP)+PEN(2)                                          00002480
      IF (NDXU.NE.0.AND.UMB(1).EQ.0.D0.AND.UMB(2).NE.0.D0)              00002490
     *   SC(24)=S(NDXU)+UMB(2)                                          00002500
      RETURN                                                            00002510
C                                                                       00002520
C                                                                       00002530
C*****LAUCON OUTPUT FOR MODE=3 ***                                      00002540
 3000 DO 3010 K=1,5                                                     00002550
      SC(K)    =    PEN(K)                                              00002560
 3010 SC(5+K)  =    UMB(K)                                              00002570
      DO 3014 K=1,4                                                     00002580
 3014 SC(10+K) =    EXXON(K)                                            00002590
      GO TO (3100,3200,3300),M                                          00002600
 3100 NDXU=0                                                            00002610
      NPDX=0                                                            00002620
      CALL DRILL (NDXU,NDXP,KCAN,TARC,JJPEN,JJUMB,PEN,UMB)              00002630
      RETURN                                                            00002640
C     ORBIT 2 ONLY                                                      00002650
 3200 DO 3218 K=1,4                                                     00002660
 3218 SC(14+K) =    ENCO(K)                                             00002670
      SC(19)   =    ASP                                                 00002680
      SC(20)   =    ASPR1                                               00002690
      SC(21)   =    APOGEO                                              00002700
      SC(22)   =    PERGEO                                              00002710
      SC(23)=0.D0                                                       00002720
      SC(24)=0.D0                                                       00002730
      IF (NDXP.NE.0.AND.PEN(1).EQ.0.D0.AND.PEN(2).NE.0.D0)              00002740
     *   SC(23)=S(NDXP)+PEN(2)                                          00002750
      IF (NDXU.NE.0.AND.UMB(1).EQ.0.D0.AND.UMB(2).NE.0.D0)              00002760
     *   SC(24)=S(NDXU)+UMB(2)                                          00002770
      RETURN                                                            00002780
C     ORBIT 3 ONLY                                                      00002790
 3300 DO 3318 K=1,4                                                     00002800
 3318 SC(14+K) =    ENCO(K)                                             00002810
      SC(19)   =    ASP                                                 00002820
      SC(20)   =    ASPN                                                00002830
      SC(21)   =    ASPR1                                               00002840
      SC(22)   =    ASPNR1                                              00002850
      SC(23)   =    ASPDEP                                              00002860
      SC(24)   =    ASNDEP                                              00002870
      RETURN                                                            00002880
C                                                                       00002890
C                                                                       00002900
C*****LAUCON OUTPUT FOR MODE=4 ***                                      00002910
 4000 DO 4010 K=1,5                                                     00002920
      SC(K)    =    PEN(K)                                              00002930
 4010 SC(5+K)  =    UMB(K)                                              00002940
      DO 4014 K=1,4                                                     00002950
 4014 SC(10+K) =    EXXON(K)                                            00002960
      GO TO (4100,4200,4300,4400),M                                     00002970
C     ORBIT 1 ONLY                                                      00002980
 4100 NDXU=0                                                            00002990
      NDXP=0                                                            00003000
      CALL DRILL (NDXU,NDXP,KCAN,TARC,JJPEN,JJUMB,PEN,UMB)              00003010
      RETURN                                                            00003020
C     ORBIT 2 ONLY                                                      00003030
 4200 DO 4218 K=1,4                                                     00003040
 4218 SC(14+K) =    ENCO(K)                                             00003050
      SC(19)   =    ASP                                                 00003060
      SC(20)   =    ASPR1                                               00003070
      SC(21)   =    APOGEO                                              00003080
      SC(22)   =    PERGEO                                              00003090
      SC(23)=0.D0                                                       00003100
      SC(24)=0.D0                                                       00003110
      IF (NDXP.NE.0.AND.PEN(1).EQ.0.D0.AND.PEN(2).NE.0.D0)              00003120
     *   SC(23)=S(NDXP)+PEN(2)                                          00003130
      IF (NDXU.NE.0.AND.UMB(1).EQ.0.D0.AND.UMB(2).NE.0.D0)              00003140
     *   SC(24)=S(NDXU)+UMB(2)                                          00003150
      RETURN                                                            00003160
C     ORBIT 3 ONLY                                                      00003170
 4300 DO 4318 K=1,4                                                     00003180
 4318 SC(14+K) =    ENCO(K)                                             00003190
      SC(19)   =    ASP                                                 00003200
      SC(20)   =    ASPN                                                00003210
      SC(21)   =    ASPR1                                               00003220
      SC(22)   =    ASPNR1                                              00003230
      RETURN                                                            00003240
C     ORBIT 4 ONLY                                                      00003250
 4400 DO 4418 K=1,4                                                     00003260
 4418 SC(14+K) =    ENCO(K)                                             00003270
      SC(19)   =    ASP                                                 00003280
      SC(20)   =    ASPN                                                00003290
      RETURN                                                            00003300
C                                                                       00003310
C                                                                       00003320
C*****LAUCON OUTPUT FOR MODE=5 ***                                      00003330
 5000 DO 5010 K=1,5                                                     00003340
      SC(K)    =    PEN(K)                                              00003350
 5010 SC(5+K)  =    UMB(K)                                              00003360
      DO 5014 K=1,4                                                     00003370
 5014 SC(10+K) =    EXXON(4)                                            00003380
      SC(15)   =    ASP                                                 00003390
      SC(16)   =    ASPN                                                00003400
      RETURN                                                            00003410
C                                                                       00003420
 9000 FORMAT (1H0, 'SUBROUTINE LAUCON WARNING -- FOR MODE=', I2, ' NO SP00003430
     2ECIAL PROVISIONS WERE MADE IN LAUCON FOR FILLING UP THE CONSTRAINE00003440
     3D-PARAMETER   '/'                              OUTPUT ARRAY. IT WA00003450
     4S THEREFORE FILLED IN ACCORDANCE WITH THE OUTPUT-PARAMETER CODE NU00003460
     5MBERS FOR MODE=1.')                                               00003470
      END                                                               00003480
C          DATA SET LIST       AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE LIST(N)                                                00000010
C                                                                       00000020
C                                                                       00000030
C     SUBROUTINE LIST (N)                                               00000040
C                                                                       00000050
C                                                                       00000060
C                                                                       00000070
C     THE PURPOSE OF LIST IS TO PRINT ON UNIT 6 THE INPUT CARD IMAGES   00000080
C         FROM ANY GIVEN UNIT.                                          00000090
C                                                                       00000100
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000110
C                                                                       00000120
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000130
C                                                                       00000140
C          N         I*4      I      DATASET REFERENCE NUMBER OF        00000150
C                                       INPUT CARDS                     00000160
C                                                                       00000170
C                                                                       00000180
C                                                                       00000190
C     LIST IS CALLED BY THE FOLLOWING SUBROUTINE.                       00000200
C                                                                       00000210
C         MAIN                                                          00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C                                                                       00000260
C     NO SUBROUTINES ARE CALLED BY LIST.                                00000270
C                                                                       00000280
C                                                                       00000290
C                                                                       00000300
C     LIST NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00000310
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
      REAL*8 CARD(10)                                                   00000360
      WRITE(6,10) N                                                     00000370
   10 FORMAT(1H1,3X,'INPUT CARD IMAGES *** DATA SET REF. NO. ',I2///)   00000380
  101 READ(N,11,END=800,ERR=500) CARD                                   00000390
   11 FORMAT(10A8)                                                      00000400
      WRITE(6,13) CARD                                                  00000410
   13 FORMAT(1X,10A8)                                                   00000420
      GO TO 101                                                         00000430
  500 WRITE(6,12)                                                       00000440
   12 FORMAT(///5X,'INPUT ERROR',///)                                   00000450
  800 REWIND N                                                          00000460
      RETURN                                                            00000470
      END                                                               00000480
C          DATA SET MAIN       AT LEVEL 001 AS OF 11/06/78
C     PROGRAM OILCAN                                                    00000010
C     ORBITAL INSERTION AND LAUNCH CONSTRAINT ANALYSIS                  00000020
C     PROGRAMMED BY N. CARY, COMPUTER SCIENCES CORPORATION              00000030
C     SYSTEM SCIENCES DIVISION, ORBITAL DETERMINATION DEPARTMENT,       00000040
C     MISSION ANALYSIS SECTION                                          00000050
C     MAIN.      DESIGNATES AUTHORITY TO DRIVER FOR MODE REQUESTED.     00000060
C                                                                       00000070
C                                                                       00000080
      IMPLICIT REAL*8(A-H,O-Z)                                          00000090
      NAMELIST/CHOICE/MODE                                              00000100
      CALL LIST(5)                                                      00000110
      J=0                                                               00000120
  100 J=J+1                                                             00000130
      READ(5,CHOICE,END=1000)                                           00000140
      GO TO (101,102,103,104,105,106,107,108,109,110),MODE              00000150
      WRITE (6,1001)                                                    00000160
 1000 STOP                                                              00000170
  101 IF (J .EQ. 1) CALL DFALT1                                         00000180
      CALL MODE1(MODE)                                                  00000190
      GO TO 100                                                         00000200
  102 IF (J .EQ. 1) CALL DFALT2                                         00000210
      CALL MODE2(MODE)                                                  00000220
      GO TO 100                                                         00000230
  103 IF (J .EQ. 1) CALL DFALT3                                         00000240
      CALL MODE3(MODE)                                                  00000250
      GO TO 100                                                         00000260
  104 IF (J .EQ. 1) CALL DFALT4                                         00000270
      CALL MODE4(MODE)                                                  00000280
      GO TO 100                                                         00000290
  105 IF (J .EQ. 1) CALL DFALT5                                         00000300
      CALL MODE5 (MODE)                                                 00000310
      GO TO 100                                                         00000320
  106 CALL MODE6(MODE)                                                  00000330
      GO TO 100                                                         00000340
  107 CALL MODE7(MODE)                                                  00000350
      GO TO 100                                                         00000360
  108 CALL MODE8(MODE)                                                  00000370
      GO TO 100                                                         00000380
  109 CALL MODE9(MODE)                                                  00000390
      GO TO 100                                                         00000400
  110 CALL MODE10(MODE)                                                 00000410
      GO TO 100                                                         00000420
1001  FORMAT (1H1, 'MESSAGE FROM MAIN. MODE .GT. 10. OILCAN HAS NO CODE 00000430
     *FOR SUCH A MODE.')                                                00000440
      END                                                               00000450
C          DATA SET MEANOM     AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE MEANOM (ECC, ANOM, EANOM, AMEAN)                       00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE MEANOM (ECC,ANOM,EANOM,AMEAN)                          00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF MEANOM IS TO CALCULATE THE ECCENTRIC AND MEAN      00000090
C         ANOMALIES CORRESPONDING TO A GIVEN ECCENTRICITY AND TRUE      00000100
C         ANOMALY.                                                      00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          ECC       R*8      I      ECCENTRICITY                       00000190
C          ANOM      R*8      I      TRUE ANOMALY (RADIANS)             00000200
C          EANOM     R*8      O      ECCENTRIC ANOMALY (RADIANS)        00000210
C          AMEAN     R*8      O      MEAN ANOMALY (RADIANS)             00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C     MEANOM IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000260
C                                                                       00000270
C          ARCTIM   LAUCON    OFSHOR    SUNOCO                          00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     NO SUBROUTINES ARE CALLED BY MEANOM.                              00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     MEANOM NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000360
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
      DATA TWOPI /6.2831853071795864D0/                                 00000410
      DIV = 1.D0 + ECC*DCOS(ANOM)                                       00000420
      COSE = (ECC + DCOS(ANOM))/ DIV                                    00000430
      SINE = DSQRT(1.D0 - ECC*ECC) * DSIN(ANOM) / DIV                   00000440
      EANOM = DATAN2(SINE,COSE)                                         00000450
      AMEAN = EANOM - ECC*DSIN(EANOM)                                   00000460
      IF (EANOM .LT. 0.D0) EANOM=EANOM + TWOPI                          00000470
      IF (AMEAN .LT. 0.D0)  AMEAN = AMEAN + TWOPI                       00000480
      RETURN                                                            00000490
      END                                                               00000500
C          DATA SET MODE1      AT LEVEL 001 AS OF 11/07/78
      SUBROUTINE MODE1(MODE)                                            00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****DRIVER ROUTINE FOR MODE=1                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MODE1(MODE)                                            00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MODE1 IS TO SERVE AS THE DRIVER ROUTINE FOR MISSION00000100
C         ANALYSIS OF ONE ORBIT INPUT AS A SPHERICAL STATE VECTOR.      00000110
C         SCANS ARE CARRIED OUT OVER LAUNCH DATE AND EITHER NODE OR     00000120
C         LAUNCH TIME.                                                  00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          MODE      I*4      I      PROGRAM MODE                       00000210
C                                                                       00000220
C                                                                       00000230
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MODE1.                    00000240
C                                                                       00000250
C                   GEOM      LATIME    OUTELM    RECEL     SUNEPH      00000260
C         DATOUT    INPUT1    LAUCON    OUTHED    ROT2XY    TIMEC       00000270
C         DEGRAD    INSERT    NODROT    OUTSET    SPILL     TITLE1      00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     MODE1 IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000320
C                                                                       00000330
C         MAIN                                                          00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000380
C                                                                       00000390
C         COMMON VARIABLES USED                                         00000400
C                                                                       00000410
C         ARC1      FDATE     JDATE     JUMB1     MOFLAG    SDATE       00000420
C         DNODE     FNODE     JPEN1     KCAN1(20) MORB      SNODE       00000430
C         DTIME     FTIME     JSCAN     KREVS1    MSUN      STIME       00000440
C                                                           TLINJ       00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
C*****INPUTS ENTER THRU BLOCKS COMMON W/ INPUT1 AND DFALT1 ROUTINES*****00000490
C +++ COMMON /SCANS/                                                    00000500
C     TLINJ               (I) TIME (SECS) BETWEEN LAUNCH TIME AND       00000510
C                             ORBIT 1 INJECTION TIME                    00000520
C     JSCAN               (I) FLAG FOR SCAN OPTION --                   00000530
C                             =1, SCAN OVER NODE. (COMPUTE LAUNCH TIME) 00000540
C                             =2, SCAN OVER LAUNCH TIME. (COMPUTE NODE) 00000550
C     SNODE,FNODE,DNODE   (I) STARTING & FINISHING NODES & INCREMENT OF 00000560
C                             NODE SCAN (RADIANS)                       00000570
C     STIME,FTIME,DTIME   (I) STARTING & FINISHING TIMES & INCREMENT OF 00000580
C                             TIME SCAN (HOURS)                         00000590
C     SDATE,FDATE,JDATE   (I) STARTING & FINISHING CALENDAR DATES       00000600
C                             (YYMM.DD) & INTEGER INCREMENT OF DATE SCAN00000610
C                                                                       00000620
C +++ COMMON /ONECAN/                                                   00000630
C                   ++(SEE ALSO LAUCON DESCRIPTION)++                   00000640
C     TESSO1              (I) TIME  USED IN EARTH-SAT-SUN ANGLE ANALYSIS00000650
C     ARC1                (I) ANALYZE SHADOWS ALONG THIS ARC            00000660
C     KCAN1(20)           (I) FLAGS FOR CHOOSING CONSTRAINT ANALYSES    00000670
C     KREVS1              (I) NO. OF EXTRA REVS IN THIS ORBIT           00000680
C     JUMB1               (I) FLAG  FOR UMBRAL SHADOW ANALYSIS          00000690
C     JPEN1               (I) FLAG  FOR PENUMBRAL SHADOW ANALYSIS       00000700
C                                                                       00000710
C +++ COMMON /ORBOUT/                                                   00000720
C     MSUN                (I) PRINTER UNIT FOR SUN EPHEMERIS (INTEGER)  00000730
C     MORB                (I) PRINTER UNIT FOR ORBITAL INFO. SUMMARY    00000740
C                             TABLE (INTEGER)                           00000750
C     MOFLAG              (I) PRINT ORB. INFO. SUMMARY TABLE --         00000760
C                             (.EQ. 0) FOR 1ST & LAST NODE/TIME IN SCAN 00000770
C                             (.NE. 0) FOR EVERY NODE/TIME IN THE SCAN  00000780
C                                                                       00000790
C*****OUTPUTS ARE PASSED THRU ARRAY S(100) TO THE 'SPILL' ROUTINE.      00000800
C     ALL OUTPUT ANGLES ARE IN DEGREES.                                 00000810
C                                                                       00000820
C                                                                       00000830
      REAL*8 INC1,NODE1,NODE                                            00000840
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00000850
     2             SDATE,FDATE,JDATE,JSCAN                              00000860
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000870
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000880
      DIMENSION REL(3),VES(3),R(3),V(3),ELM(6),S1C(50),S(100)           00000890
      EQUIVALENCE (ELM(1),A1),          (ELM(2),E1)                     00000900
C                                                                       00000910
C***FILL IN ELEMENTS OF OUTPUT ARRAYS. (MISSING ARE ELEMENTS THAT APPEAR00000920
C     IN COMMON -- THEY'RE FILLED IN NEAR THE END OF THIS SUBROUTINE.)  00000930
      EQUIVALENCE (S(3),ELM(1)),   (S(9),P1),       (S(10),ELAPSE),     00000940
     2            (S(51),S1C(1))                                        00000950
C                                                                       00000960
      DATA U/398600.8D0/                                                00000970
      CALL INPUT1                                                       00000980
C                                                                       00000990
C***SET UP DIRECT-ACCESS STORAGE FOR OUTPUT.                            00001000
C$C$  DEFINE FILE 50(5929,300,U,JAV)                                    00001010
      JAV = 1                                                           00001020
C                                                                       00001030
C***SET UP PRINTER OUTPUT.                                              00001040
      CALL TITLE1 (MODE,N)                                              00001050
C                                                                       00001060
C***DETERMINE ORIENTATION OF ORBIT 1 W.R.T. COORDS ROTATING W/ THE EARTH00001070
      CALL GEOM (OMEGA,REL,VES)                                         00001080
C                                                                       00001090
C***SET UP INTEGER LIMITS TO DATE SCAN IN TERMS OF DAYS SINCE 1950.0.   00001100
      CALL TIMEC (SDATE,0.D0,DAY,XM)                                    00001110
      JSDAY = DAY                                                       00001120
      CALL TIMEC (FDATE,0.D0,DAY,XM)                                    00001130
      JFDAY = DAY                                                       00001140
      JM = (JFDAY-JSDAY)/JDATE + 1                                      00001150
C                                                                       00001160
C***COMPUTE A SUN POSITION EPHEMERIS AT 12 HR INTERVALS STARTING AT 0 HR00001170
C     ON SDATE AND ENDING AT 12 HR ON 10TH DAY AFTER FDATE.             00001180
      CALL SUNEPH (MSUN, JSDAY, JFDAY-JSDAY+10)                         00001190
C                                                                       00001200
C***COUNT UP NUMBER OF NODES OR TIMES IN THE NODE OR TIME SCAN.         00001210
      IF (JSCAN .EQ. 1) JN = (FNODE-SNODE)/DNODE + 1.00001D0            00001220
      IF (JSCAN .EQ. 2) JN = (FTIME-STIME)/DTIME + 1.00001D0            00001230
C                                                                       00001240
C***********************NODE OR TIME SCAN***********************        00001250
C                                                                       00001260
      DO 300 JY=1,JN                                                    00001270
      IF (JSCAN .EQ. 1) NODE = SNODE + (JY-1)*DNODE                     00001280
      IF (JSCAN .EQ. 2) GMTL = STIME + (JY-1)*DTIME                     00001290
C                                                                       00001300
C***********************DATE SCAN************************               00001310
C                                                                       00001320
      DO 300 JJJ = JSDAY, JFDAY, JDATE                                  00001330
      ELAPSE = JJJ - JSDAY                                              00001340
      DAY=JJJ                                                           00001350
C                                                                       00001360
C***DETERMIN INJ TIME, GR'NWICH HOUR ANGLE, & EITHER LAUNCH TIME OR NODE00001370
      CALL LATIME(JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)              00001380
      CALL DATOUT(DAY,0.D0,DATE,XM,1)                                   00001390
      TIN=TIME                                                          00001400
      IF ((JSCAN .EQ. 1) .AND. (JJJ .NE. JSDAY)) GO TO 200              00001410
C                                                                       00001420
C***ROTATE INJ. POS. & VEL. VECTORS FROM GREENWICH INTO EQUINOX COORDS  00001430
      CALL ROT2XY(HA,REL,R)                                             00001440
      CALL ROT2XY(HA,VES,V)                                             00001450
C                                                                       00001460
C***CONVERT ORBIT 1 FROM CARTESIAN COORDINATES TO KEPLERIAN ELEMENTS    00001470
      CALL RECEL (U,R,V,TFP,ELM,XM)                                     00001480
      CALL DEGRAD (1,ELM(3),ELM(4),ELM(5),ELM(6),INC1,NODE1,ARGP1,ANOM1)00001490
C                                                                       00001500
C***WRITE OUT ORBITAL INFORMATION SUMMARY TABLE. ANGLES IN DEGREES.     00001510
      IF ((MORB .EQ. 0) .OR. (JJJ .NE. JSDAY))  GO TO 200               00001520
      IF ((MOFLAG .EQ. 0) .AND. (JY .NE. 1) .AND. (JY .NE. JN))GO TO 20000001530
      CALL OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN,NODE)                 00001540
      CALL OUTELM (MORB,1,ELM(1),ELM(2),ELM(3),ELM(4),ELM(5),ELM(6))    00001550
C                                                                       00001560
C*****CONSTRAINT ANALYSIS.*****                                         00001570
  200 TPASS = DAY + TIME/24.D0                                          00001580
      CALL LAUCON (MODE,1,JSDAY,DAY,TIME,STAY1,A1,E1,INC1,NODE1,ARGP1,  00001590
     2                              ANOM1,P1,TPASS,  V   ,TESSO1,ARC1,  00001600
     3                              KCAN1,KREVS1,JUMB1,JPEN1,S1C,S,N)   00001610
C                                                                       00001620
C***OUTPUT (UNITS--MINUTES, KM, KM/SEC, DEGREES)                        00001630
C     FILL IN THOSE ELEMENTS OF THE S1,S2,S3,ARRAYS THAT MUST NOT APPEAR00001640
C       IN EQUIVALENCE STATEMENTS.                                      00001650
      S(1)   = DATE                                                     00001660
      S(2)   = TIN                                                      00001670
      S(11)  = GMTL                                                     00001680
      JX = (JJJ-JSDAY)/JDATE + 1                                        00001690
      CALL SPILL (S, N, JX, JM*(JY-1)+JX, JM*JN, JAV)                   00001700
  300 CONTINUE                                                          00001710
C$C$  JX = ELAPSE + 1.00001D0                                           00001720
C$C$  CALL TABLES (H,JX,JY,JAV)  ***BUT SEND H THRU COMMON, MAYBE ***   00001730
      RETURN                                                            00001740
      END                                                               00001750
C          DATA SET MODE10     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE10(MODE)                                           00000010
      IMPLICIT REAL*8(A-I,L,N-Z)                                        00000020
      WRITE (6,1001) MODE                                               00000030
      RETURN                                                            00000040
 1001 FORMAT (1H1, 'MODE=',I3)                                          00000050
      END                                                               00000060
C          DATA SET MODE2      AT LEVEL 001 AS OF 11/07/78              00000000
      SUBROUTINE MODE2(MODE)                                            00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****DRIVER ROUTINE FOR MODE=2                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MODE2(MODE)                                            00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MODE2 IS TO SERVE AS THE DRIVER ROUTINE FOR        00000100
C         MISSIONS INVOLVING CONSTRAINED-PARAMETER ANALYSIS ON TWO      00000110
C         ORBITS (E.G. PARKING AND FINAL).                              00000120
C         SCANS ARE CARRIED OUT OVER LAUNCH DATE AND EITHER NODE OR     00000130
C         LAUNCH TIME.                                                  00000140
C                                                                       00000150
C                                                                       00000160
C                                                                       00000170
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000180
C                                                                       00000190
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000200
C                                                                       00000210
C          MODE      I*4      I      PROGRAM MODE                       00000220
C                                                                       00000230
C                                                                       00000240
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MODE2.                    00000250
C                                                                       00000260
C         BADANG    GEOM      LATIME    OUTELM    RECEL     SUNEPH      00000270
C         DATOUT    INPUT2    LAUCON    OUTHED    ROT2XY    TIMEC       00000280
C         DEGRAD    INSERT    NODROT    OUTSET    SPILL     TITLE2      00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     MODE2 IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000330
C                                                                       00000340
C         MAIN                                                          00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000390
C                                                                       00000400
C         COMMON VARIABLES USED                                         00000410
C                                                                       00000420
C         ARC1      FDATE     JINS2     JUMB1     KREVS2    SNODE       00000430
C         ARC2      FNODE     JNOD2     JUMB2     MOFLAG    STIME       00000440
C         DNMAX2    FTIME     JPEN1     KCAN1(20) MORB      TESSO1      00000450
C         DNODE     JDATE     JPEN2     KCAN2(20) MSUN      TESSO2      00000460
C         DTIME     JGIDE2    JSCAN     KREVS1    SDATE     TLINJ       00000470
C                                                                       00000480
C         COMMON VARIABLES USED AND COMPUTED                            00000490
C                                                                       00000500
C         A2        DV2       INC2      NODE2                           00000510
C                                                                       00000520
C                                                                       00000530
C                                                                       00000540
C*****INPUTS ENTER THRU BLOCKS COMMON W/ INPUT2 AND DFALT2 ROUTINES*****00000550
C +++ COMMON /SCANS/                                                    00000560
C     TLINJ               (I) TIME (SECS) BETWEEN LAUNCH TIME AND       00000570
C                             ORBIT 1 INJECTION TIME                    00000580
C     JSCAN               (I) FLAG FOR SCAN OPTION --                   00000590
C                             =1, SCAN OVER NODE. (COMPUTE LAUNCH TIME) 00000600
C                             =2, SCAN OVER LAUNCH TIME. (COMPUTE NODE) 00000610
C     SNODE,FNODE,DNODE   (I) STARTING & FINISHING NODES & INCREMENT OF 00000620
C                             NODE SCAN (RADIANS)                       00000630
C     STIME,FTIME,DTIME   (I) STARTING & FINISHING TIMES & INCREMENT OF 00000640
C                             TIME SCAN (HOURS)                         00000650
C     SDATE,FDATE,JDATE   (I) STARTING & FINISHING CALENDAR DATES       00000660
C                             (YYMM.DD) & INTEGER INCREMENT OF DATE SCAN00000670
C                                                                       00000680
C +++ COMMON /TWO/ (FOR ORBIT 2)                                        00000690
C                   ++(SEE ALSO INSERT,DVEL,NODROT DESCRIPTIONS)++      00000700
C     A2,DV2,INC2         (I/O, DEPENDING ON JGIDE) --                  00000710
C                               SEMIMAJOR AXIS (KM), MANEUVER VELOCITY  00000720
C                               MAGNITUDE  (KM/S), INCLINATION  (RADS)  00000730
C     NODE2               (I/O, DEPENDING ON JNOD & JGIDE) --           00000740
C                               ASCENDING NODE  (RADIANS)               00000750
C     DNMAX2              (I) NODE ROTATION  (RADS) (SEE NODROT ROUTINE)00000760
C     JGIDE2              (I) FLAG  FOR CHOOSING MANEUVR GUIDANCE OPTION00000770
C     JNOD2               (I) FLAG  FOR CHOOSING NODE ROTATION OPTION   00000780
C     JINS2               (I) FLAG  FOR CHOOSING INSERTION POINT        00000790
C     ARGPI2              (I) ARGUMENT OF PERIGEE (RADS)                00000800
C     TA1                 (I) TRUE ANOMALY IN OLD ORBIT AT WHICH        00000810
C                             INSERTION INTO NEW ORBIT OCCURS           00000820
C     THETA2,BETA2        (I) DECLINATION AND RIGHT ASCENSION ANGLES    00000830
C                             DEFINING THE DELTAV VECTOR IN THE LOCAL   00000840
C                             TANGENT SYSTEM                            00000850
C                                                                       00000860
C +++ COMMON /ONECAN/ (ORBIT 1), /TWOCAN/ (ORBIT 2)                     00000870
C                   ++(SEE ALSO LAUCON DESCRIPTION)++                   00000880
C     TESSO1,TESSO2       (I) TIMES USED IN EARTH-SAT-SUN ANGLE ANALYSIS00000890
C     ARC1,ARC2           (I) ANALYZE SHADOWS ALONG THESE ARCS          00000900
C     KCAN1(20),KCAN2(20) (I) FLAGS FOR CHOOSING CONSTRAINT ANALYSES    00000910
C     KREVS1,KREVS2       (I) NO. OF EXTRA REVS IN EACH ORBIT           00000920
C     JUMB1,JUMB2         (I) FLAGS FOR UMBRAL SHADOW ANALYSIS          00000930
C     JPEN1,JPEN2         (I) FLAGS FOR PENUMBRAL SHADOW ANALYSIS       00000940
C                                                                       00000950
C +++ COMMON /ORBOUT/                                                   00000960
C     MSUN                (I) PRINTER UNIT FOR SUN EPHEMERIS (INTEGER)  00000970
C     MORB                (I) PRINTER UNIT FOR ORBITAL INFO. SUMMARY    00000980
C                             TABLE (INTEGER)                           00000990
C     MOFLAG              (I) PRINT ORB. INFO. SUMMARY TABLE --         00001000
C                             (.EQ. 0) FOR 1ST & LAST NODE/TIME IN SCAN 00001010
C                             (.NE. 0) FOR EVERY NODE/TIME IN THE SCAN  00001020
C                                                                       00001030
C*****OUTPUTS ARE PASSED THRU ARRAY S(200) TO THE 'SPILL' ROUTINE.      00001040
C     ALL OUTPUT ANGLES ARE IN DEGREES.                                 00001050
C                                                                       00001060
C                                                                       00001070
      REAL*8 INC1,NODE1,INC2,NODE2,NODE                                 00001080
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00001090
     2             SDATE,FDATE,JDATE,JSCAN                              00001100
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00001110
     *            JGIDE2,JNOD2,JINS2,JREL3                              00001120
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00001130
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2            00001140
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00001150
      DIMENSION REL(3),VES(3),R(3),V(3),DELV12(3),ELM(6)                00001160
      DIMENSION S1C(50),S2B(30),S2C(50),S(200)                          00001170
      EQUIVALENCE (ELM(1),A1),          (ELM(2),E1)                     00001180
      EQUIVALENCE (S2B(11),DELV12(1)), (S2B(4),STAY1)                   00001190
C                                                                       00001200
C***FILL IN ELEMENTS OF OUTPUT ARRAYS. (MISSING ARE ELEMENTS THAT APPEAR00001210
C     IN COMMON -- THEY'RE FILLED IN NEAR THE END OF THIS SUBROUTINE.)  00001220
      EQUIVALENCE (S(3),ELM(1)),   (S(9),P1),       (S(10),ELAPSE),     00001230
     2            (S(51),S1C(1))                                        00001240
      EQUIVALENCE (S(101),DATE2),  (S(102),TIN2),   (S(104),E2),        00001250
     2            (S(105),XI2),    (S(106),XNOD2),  (S(107),AOP2),      00001260
     3            (S(108),TRUE2),  (S(109),P2),                         00001270
     4            (S(121),S2B(1)), (S(151),S2C(1))                      00001280
      DATA U/398600.8D0/                                                00001290
C                                                                       00001300
C***READ INPUTS. STORE VALUES THAT MAY UNDERGO INTERNAL CHANGES.        00001310
      CALL INPUT2                                                       00001320
      SAVN2 = NODE2                                                     00001330
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVA2=A2                     00001340
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVI2=INC2                   00001350
C                                                                       00001360
C***SET UP DIRECT-ACCESS STORAGE FOR OUTPUT.                            00001370
C$C$  DEFINE FILE 50(5929,300,U,JAV)                                    00001380
      JAV = 1                                                           00001390
C                                                                       00001400
C***SET UP PRINTER OUTPUT.                                              00001410
      CALL TITLE2 (MODE,N)                                              00001420
C                                                                       00001430
C***DETERMINE ORIENTATION OF ORBIT 1 W.R.T. COORDS ROTATING W/ THE EARTH00001440
      CALL GEOM (OMEGA,REL,VES)                                         00001450
C                                                                       00001460
C***SET UP INTEGER LIMITS TO DATE SCAN IN TERMS OF DAYS SINCE 1950.0.   00001470
      CALL TIMEC (SDATE,0.D0,DAY,XM)                                    00001480
      JSDAY = DAY                                                       00001490
      CALL TIMEC (FDATE,0.D0,DAY,XM)                                    00001500
      JFDAY = DAY                                                       00001510
      JM = (JFDAY-JSDAY)/JDATE + 1                                      00001520
C                                                                       00001530
C***COMPUTE A SUN POSITION EPHEMERIS AT 12 HR INTERVALS STARTING AT 0 HR00001540
C     ON SDATE AND ENDING AT 12 HR ON 10TH DAY AFTER FDATE.             00001550
      CALL SUNEPH (MSUN, JSDAY, JFDAY-JSDAY+10)                         00001560
C                                                                       00001570
C***COUNT UP NUMBER OF NODES OR TIMES IN THE NODE OR TIME SCAN.         00001580
      IF (JSCAN .EQ. 1) JN = (FNODE-SNODE)/DNODE + 1.00001D0            00001590
      IF (JSCAN .EQ. 2) JN = (FTIME-STIME)/DTIME + 1.00001D0            00001600
C                                                                       00001610
C***********************NODE OR TIME SCAN***********************        00001620
C                                                                       00001630
      DO 300 JY=1,JN                                                    00001640
      IF (JSCAN .EQ. 1) NODE = SNODE + (JY-1)*DNODE                     00001650
      IF (JSCAN .EQ. 2) GMTL = STIME + (JY-1)*DTIME                     00001660
C                                                                       00001670
C***********************DATE SCAN************************               00001680
C                                                                       00001690
      DO 300 JJJ = JSDAY, JFDAY, JDATE                                  00001700
      ELAPSE = JJJ - JSDAY                                              00001710
      DAY=JJJ                                                           00001720
C                                                                       00001730
C***DETERMIN INJ TIME, GR'NWICH HOUR ANGLE, & EITHER LAUNCH TIME OR NODE00001740
      CALL LATIME(JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)              00001750
      CALL DATOUT(DAY,0.D0,DATE,XM,1)                                   00001760
      TIN=TIME                                                          00001770
      IF ((JSCAN .EQ. 1) .AND. (JJJ .NE. JSDAY)) GO TO 200              00001780
C                                                                       00001790
C***ROTATE INJ. POS. & VEL. VECTORS FROM GREENWICH INTO EQUINOX COORDS  00001800
      CALL ROT2XY(HA,REL,R)                                             00001810
      CALL ROT2XY(HA,VES,V)                                             00001820
C                                                                       00001830
C***CONVERT ORBIT 1 FROM CARTESIAN COORDINATES TO KEPLERIAN ELEMENTS    00001840
      CALL RECEL (U,R,V,TFP,ELM,XM)                                     00001850
      CALL DEGRAD (1,ELM(3),ELM(4),ELM(5),ELM(6),INC1,NODE1,ARGP1,ANOM1)00001860
C                                                                       00001870
C***NODE OF ORBIT 2 DEPENDS ON NODE ROTATION OPTION.                    00001880
      CALL NODROT(JNOD2,NODE1,NODE2,DNMAX2)                             00001890
C                                                                       00001900
C***CHECK FOR PROBLEMATIC INCLINATIONS OR NODES                         00001910
      IF(JGIDE2 .LT. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,1)        00001920
      IF(JGIDE2 .EQ. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,0)        00001930
C                                                                       00001940
C***UNITIZE VECTOR R FOR USE IN ROUTINE INSERT                          00001950
      RMAG = DSQRT(R(1)**2 + R(2)**2 + R(3)**2)                         00001960
      DO 35 KAY=1,3                                                     00001970
  35  R(KAY) = R(KAY) / RMAG                                            00001980
C                                                                       00001990
C***DO MANEUVER CALCULATIONS & COMPUTE ORBIT 2 ELEMENTS, TIMES, ATTITUDE00002000
      CALL INSERT (JINS2,JGIDE2,JAPS2,A1,E1,INC1,NODE1,ARGP1,ANOM1,     00002010
     2             R,A2,E2,INC2,NODE2,ARGP2,ANOM2,DV2,S2B,ARGPI2,       00002020
     3             THETA2,BETA2,TA1,JREL3)                              00002030
C                                                                       00002040
C***WRITE OUT ORBITAL INFORMATION SUMMARY TABLE. ANGLES IN DEGREES.     00002050
      CALL DEGRAD (0,XI2,XNOD2,AOP2,TRUE2,INC2,NODE2,ARGP2,ANOM2)       00002060
      IF ((MORB .EQ. 0) .OR. (JJJ .NE. JSDAY))  GO TO 200               00002070
      IF ((MOFLAG .EQ. 0) .AND. (JY .NE. 1) .AND. (JY .NE. JN))GO TO 20000002080
      CALL OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN,NODE)                 00002090
      CALL OUTELM (MORB,1,ELM(1),ELM(2),ELM(3),ELM(4),ELM(5),ELM(6))    00002100
      CALL OUTSET (MORB,1,2,JAPS2,S2B)                                  00002110
      CALL OUTELM (MORB,2,A2,E2,XI2,XNOD2,AOP2,TRUE2)                   00002120
C                                                                       00002130
C*****CONSTRAINT ANALYSIS.*****                                         00002140
  200 TPASS = DAY + TIME/24.D0                                          00002150
      CALL LAUCON (MODE,1,JSDAY,DAY,TIME,STAY1,A1,E1,INC1,NODE1,ARGP1,  00002160
     2                              ANOM1,P1,TPASS,  V   ,TESSO1,ARC1,  00002170
     3                              KCAN1,KREVS1,JUMB1,JPEN1,S1C,S,N)   00002180
      CALL DATOUT (DAY,0.D0,DATE2,XM,1)                                 00002190
      TIN2 = TIME                                                       00002200
      CALL LAUCON (MODE,2,JSDAY,DAY,TIME,STAY2,A2,E2,INC2,NODE2,ARGP2,  00002210
     2                              ANOM2,P2,TPASS,DELV12,TESSO2,ARC2,  00002220
     3                              KCAN2,KREVS2,JUMB2,JPEN2,S2C,S,N)   00002230
C                                                                       00002240
C***OUTPUT (UNITS--MINUTES, KM, KM/SEC, DEGREES)                        00002250
C     FILL IN THOSE ELEMENTS OF THE S1,S2,S3,ARRAYS THAT MUST NOT APPEAR00002260
C       IN EQUIVALENCE STATEMENTS.                                      00002270
      S(1)   = DATE                                                     00002280
      S(2)   = TIN                                                      00002290
      S(11)  = GMTL                                                     00002300
      S(103) = A2                                                       00002310
      JX = (JJJ-JSDAY)/JDATE + 1                                        00002320
      CALL SPILL (S, N, JX, JM*(JY-1)+JX, JM*JN, JAV)                   00002330
C                                                                       00002340
C***BEFORE RETURNING TO TOP OF SCANS FOR NEXT SCANPOINT, RESET NEEDED   00002350
C     VARIABLES TO THEIR ORIGINAL INPUT VALUES.                         00002360
      IF ((JSCAN .EQ. 1).AND.(JJJ .NE. JFDAY)) GO TO 300                00002370
      NODE2=SAVN2                                                       00002380
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) A2=SAVA2                     00002390
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) INC2=SAVI2                   00002400
  300 CONTINUE                                                          00002410
C$C$  JX = ELAPSE + 1.00001D0                                           00002420
C$C$  CALL TABLES (H,JX,JY,JAV)  ***BUT SEND H THRU COMMON, MAYBE ***   00002430
      RETURN                                                            00002440
      END                                                               00002450
C          DATA SET MODE3      AT LEVEL 003 AS OF 01/15/79              00000000
      SUBROUTINE MODE3(MODE)                                            00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****DRIVER ROUTINE FOR MODE=3                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MODE3 (MODE)                                           00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MODE3 IS TO SERVE AS THE DRIVER ROUTINE FOR        00000100
C         MISSIONS INVOLVING THREE ORBITS (E.G. PARKING, TRANSFER,      00000110
C         AND FINAL), ALL OF WHICH MAY BE SUBJECT TO CONSTRAINTS.       00000120
C         SCANS ARE CARRIED OUT OVER LAUNCH DATE AND EITHER NODE OR     00000130
C         LAUNCH TIME.                                                  00000140
C                                                                       00000150
C                                                                       00000160
C                                                                       00000170
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000180
C                                                                       00000190
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000200
C                                                                       00000210
C          MODE      I*4      I      PROGRAM MODE                       00000220
C                                                                       00000230
C                                                                       00000240
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MODE3.                    00000250
C                                                                       00000260
C         BADANG    GEOM      LATIME    OUTELM    RECEL     SUNEPH      00000270
C         DATOUT    INPUT3    LAUCON    OUTHED    ROT2XY    TIMEC       00000280
C         DEGRAD    INSERT    NODROT    OUTSET    SPILL     TITLE3      00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     MODE3 IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000330
C                                                                       00000340
C         MAIN                                                          00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000390
C                                                                       00000400
C         COMMON VARIABLES USED                                         00000410
C                                                                       00000420
C         ARC1      FDATE     JINS2     JSCAN     KREVS1    SNODE       00000430
C         ARC2      FNODE     JINS3     JUMB1     KREVS2    STIME       00000440
C         ARC3      FRAC3     JNOD2     JUMB2     KREVS3    TESSO1      00000450
C         DNMAX2    FTIME     JNOD3     JUMB3     MOFLAG    TESSO2      00000460
C         DNMAX3    JDATE     JPEN1     KCAN1(20) MORB      TESSO3      00000470
C         DNODE     JGIDE2    JPEN2     KCAN2(20) MSUN      TLINJ       00000480
C         DTIME     JGIDE3    JPEN3     KCAN3(20) SDATE                 00000490
C                                                                       00000500
C         COMMON VARIABLES USED AND COMPUTED                            00000510
C                                                                       00000520
C         A2        DV2       INC2      NODE2                           00000530
C         A3        DV3       INC3      NODE3                           00000540
C                                                                       00000550
C                                                                       00000560
C                                                                       00000570
C*****INPUTS ENTER THRU BLOCKS COMMON W/ INPUT3 AND DEALT3 ROUTINES*****00000580
C +++ COMMON /SCANS/                                                    00000590
C     TLINJ               (I) TIME (SECS) BETWEEN LAUNCH TIME AND       00000600
C                             ORBIT 1 INJECTION TIME                    00000610
C     JSCAN               (I) FLAG FOR SCAN OPTION --                   00000620
C                             =1, SCAN OVER NODE. (COMPUTE LAUNCH TIME) 00000630
C                             =2, SCAN OVER LAUNCH TIME. (COMPUTE NODE) 00000640
C     SNODE,FNODE,DNODE   (I) STARTING & FINISHING NODES & INCREMENT OF 00000650
C                             NODE SCAN (RADIANS)                       00000660
C     STIME,FTIME,DTIME   (I) STARTING & FINISHING TIMES & INCREMENT OF 00000670
C                             TIME SCAN (HOURS)                         00000680
C     SDATE,FDATE,JDATE   (I) STARTING & FINISHING CALENDAR DATES       00000690
C                             (YYMM.DD) & INTEGER INCREMENT OF DATE SCAN00000700
C                                                                       00000710
C +++ COMMON /TWO/ (FOR ORBIT 2) & COMMON /THREE/ (FOR ORBIT 3) --      00000720
C                   ++(SEE ALSO INSERT,DVEL,NODROT DESCRIPTIONS)++      00000730
C     A2,DV2,INC2,        (I/O, DEPENDING ON JGIDE) --                  00000740
C     A3,DV3,INC3               SEMIMAJOR AXES (KM), MANEUVER VELOCITY  00000750
C                               MAGNITUDES (KM/S), INCLINATIONS (RADS)  00000760
C     NODE2,NODE3         (I/O, DEPENDING ON JNOD & JGIDE) --           00000770
C                               ASCENDING NODES (RADIANS)               00000780
C     DNMAX2,DNMAX3       (I) NODE ROTATIONS (RADS) (SEE NODROT ROUTINE)00000790
C     JGIDE2,JGIDE3       (I) FLAGS FOR CHOOSING MANEUVR GUIDANCE OPTION00000800
C     JNOD2,JNOD3         (I) FLAGS FOR CHOOSING NODE ROTATION OPTION   00000810
C     JINS2,JINS3         (I) FLAGS FOR CHOOSING INSERTION POINTS       00000820
C     ARGPI2, ARGPI3      (I) ARGUMENTS OF PERIGEE                      00000830
C     TA1,TA2             (I) TRUE ANOMALY IN OLD ORBIT AT WHICH        00000840
C                             INSERTION INTO NEW ORBIT OCCURS           00000850
C     THETA2,BETA2        (I) DECLINATION AND RIGHT ASCENSION ANGLES    00000860
C     THETA3,BETA3            DEFINING THE DELTAV VECTOR IN THE LOCAL   00000870
C                             TANGENT SYSTEM                            00000880
C                                                                       00000890
C +++ COMMON /ONECAN/ (ORBIT 1), /TWOCAN/ (ORBIT 2), /THRCAN/ (ORBIT 3) 00000900
C                   ++(SEE ALSO LAUCON DESCRIPTION)++                   00000910
C     TESSO1,...,TESSO3   (I) TIMES USED IN EARTH-SAT-SUN ANGLE ANALYSIS00000920
C     ARC1,...,ARC3       (I) ANALYZE SHADOWS ALONG THESE ARCS          00000930
C     KCAN1(20),...,3(20) (I) FLAGS FOR CHOOSING CONSTRAINT ANALYSES    00000940
C     KREVS1,...,KREVS3   (I) NO. OF EXTRA REVS IN EACH ORBIT           00000950
C     JUMB1,...,JUMB3     (I) FLAGS FOR UMBRAL SHADOW ANALYSIS          00000960
C     JPEN1,...,JPEN3     (I) FLAGS FOR PENUMBRAL SHADOW ANALYSIS       00000970
C     FRAC3 (ORB 3 ONLY)  (I) TIME FRACTION OF A FULL REV (.GE. 0., .LE.00000980
C                             1.) WHICH SAT. IS CONSIDERED TO SPEND IN 300000990
C                                                                       00001000
C +++ COMMON /ORBOUT/                                                   00001010
C     MSUN                (I) PRINTER UNIT FOR SUN EPHEMERIS (INTEGER)  00001020
C     MORB                (I) PRINTER UNIT FOR ORBITAL INFO. SUMMARY    00001030
C                             TABLE (INTEGER)                           00001040
C     MOFLAG              (I) PRINT ORB. INFO. SUMMARY TABLE --         00001050
C                             (.EQ. 0) FOR 1ST & LAST NODE/TIME IN SCAN 00001060
C                             (.NE. 0) FOR EVERY NODE/TIME IN THE SCAN  00001070
C                                                                       00001080
C*****OUTPUTS ARE PASSED THRU ARRAY S(300) TO THE 'SPILL' ROUTINE.      00001090
C     ALL OUTPUT ANGLES ARE IN DEGREES.                                 00001100
C                                                                       00001110
C                                                                       00001120
      REAL*8 INC1,NODE1,INC2,NODE2,INC3,NODE3,NODE                      00001130
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00001140
     2             SDATE,FDATE,JDATE,JSCAN                              00001150
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00001160
     *            JGIDE2,JNOD2,JINS2,JREL3                              00001170
      COMMON/THREE/ A3,DV3, INC3, NODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00001180
     *              JGIDE3,JNOD3,JINS3                                  00001190
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00001200
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2            00001210
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3(20),KREVS3,JUMB3,JPEN3      00001220
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00001230
      DIMENSION REL(3),VES(3),R(3),V(3),DELV12(3),DELV23(3),ELM(6)      00001240
      DIMENSION S1C(50),S2B(30),S2C(50),S3B(30),S3C(50),S(300)          00001250
      EQUIVALENCE (ELM(1),A1),          (ELM(2),E1)                     00001260
      EQUIVALENCE (S2B(11),DELV12(1)), (S2B(4),STAY1)                   00001270
      EQUIVALENCE (S3B(11),DELV23(1)), (S3B(4),STAY2)                   00001280
C                                                                       00001290
C***FILL IN ELEMENTS OF OUTPUT ARRAYS. (MISSING ARE ELEMENTS THAT APPEAR00001300
C     IN COMMON -- THEY'RE FILLED IN NEAR THE END OF THIS SUBROUTINE.)  00001310
      EQUIVALENCE (S(3),ELM(1)),   (S(9),P1),       (S(10),ELAPSE),     00001320
     2            (S(51),S1C(1))                                        00001330
      EQUIVALENCE (S(101),DATE2),  (S(102),TIN2),   (S(104),E2),        00001340
     2            (S(105),XI2),    (S(106),XNOD2),  (S(107),AOP2),      00001350
     3            (S(108),TRUE2),  (S(109),P2),                         00001360
     4            (S(121),S2B(1)), (S(151),S2C(1))                      00001370
      EQUIVALENCE (S(201),DATE3),  (S(202),TIN3),   (S(204),E3),        00001380
     2            (S(205),XI3),    (S(206),XNOD3),  (S(207),AOP3),      00001390
     3            (S(208),TRUE3),  (S(209),P3),                         00001400
     4            (S(221),S3B(1)), (S(251),S3C(1))                      00001410
      DATA U,TWOPI/ 398600.8D0, 6.283185307179586D0/                    00001420
C                                                                       00001430
C***READ INPUTS. STORE VALUES THAT MAY UNDERGO INTERNAL CHANGES.        00001440
      CALL INPUT3                                                       00001450
      SAVN2 = NODE2                                                     00001460
      SAVN3 = NODE3                                                     00001470
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVA2=A2                     00001480
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) SAVA3=A3                     00001490
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVI2=INC2                   00001500
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) SAVI3=INC3                   00001510
C                                                                       00001520
C***SET UP DIRECT-ACCESS STORAGE FOR OUTPUT.                            00001530
C$C$  DEFINE FILE 50(5929,300,U,JAV)                                    00001540
      JAV = 1                                                           00001550
C                                                                       00001560
C***SET UP PRINTER OUTPUT.                                              00001570
      CALL TITLE3 (MODE,N)                                              00001580
C                                                                       00001590
C***DETERMINE ORIENTATION OF ORBIT 1 W.R.T. COORDS ROTATING W/ THE EARTH00001600
      CALL GEOM (OMEGA,REL,VES)                                         00001610
C                                                                       00001620
C***SET UP INTEGER LIMITS TO DATE SCAN IN TERMS OF DAYS SINCE 1950.0.   00001630
      CALL TIMEC (SDATE,0.D0,DAY,XM)                                    00001640
      JSDAY = DAY                                                       00001650
      CALL TIMEC (FDATE,0.D0,DAY,XM)                                    00001660
      JFDAY = DAY                                                       00001670
      JM = (JFDAY-JSDAY)/JDATE + 1                                      00001680
C                                                                       00001690
C***COMPUTE A SUN POSITION EPHEMERIS AT 12 HR INTERVALS STARTING AT 0 HR00001700
C     ON SDATE AND ENDING AT 12 HR ON 10TH DAY AFTER FDATE.             00001710
      CALL SUNEPH (MSUN, JSDAY, JFDAY-JSDAY+10)                         00001720
C                                                                       00001730
C***COUNT UP NUMBER OF NODES OR TIMES IN THE NODE OR TIME SCAN.         00001740
      IF (JSCAN .EQ. 1) JN = (FNODE-SNODE)/DNODE + 1.00001D0            00001750
      IF (JSCAN .EQ. 2) JN = (FTIME-STIME)/DTIME + 1.00001D0            00001760
      DO 300 JY = 1,JN                                                  00001770
C                                                                       00001780
C***********************NODE OR TIME SCAN***********************        00001790
C                                                                       00001800
      IF (JSCAN .EQ. 1) NODE = SNODE + (JY-1)*DNODE                     00001810
      IF (JSCAN .EQ. 2) GMTL = STIME + (JY-1)*DTIME                     00001820
C                                                                       00001830
C***********************DATE SCAN************************               00001840
C                                                                       00001850
      DO 300 JJJ = JSDAY, JFDAY, JDATE                                  00001860
      ELAPSE = JJJ - JSDAY                                              00001870
      DAY=JJJ                                                           00001880
C                                                                       00001890
C***DETERMIN INJ TIME, GR'NWICH HOUR ANGLE, & EITHER LAUNCH TIME OR NODE00001900
      CALL LATIME(JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)              00001910
      CALL DATOUT(DAY,0.D0,DATE,XM,1)                                   00001920
      TIN=TIME                                                          00001930
      IF ((JSCAN .EQ. 1) .AND. (JJJ .NE. JSDAY)) GO TO 200              00001940
C                                                                       00001950
C***ROTATE INJ. POS. & VEL. VECTORS FROM GREENWICH INTO EQUINOX COORDS  00001960
      CALL ROT2XY(HA,REL,R)                                             00001970
      CALL ROT2XY(HA,VES,V)                                             00001980
C                                                                       00001990
C***CONVERT ORBIT 1 FROM CARTESIAN COORDINATES TO KEPLERIAN ELEMENTS    00002000
      CALL RECEL (U,R,V,TFP,ELM,XM)                                     00002010
      CALL DEGRAD (1,ELM(3),ELM(4),ELM(5),ELM(6),INC1,NODE1,ARGP1,ANOM1)00002020
C                                                                       00002030
C***NODE ANGLES OF ORBS 2 & 3 DEPEND ON NODE ROTATION OPTION.           00002040
      CALL NODROT(JNOD2,NODE1,NODE2,DNMAX2)                             00002050
      CALL NODROT(JNOD3,NODE2,NODE3,DNMAX3)                             00002060
C                                                                       00002070
C***CHECK FOR PROBLEMATIC INCLINATIONS OR NODES                         00002080
      IF(JGIDE2 .LT. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,1)        00002090
      IF(JGIDE2 .EQ. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,0)        00002100
      IF(JGIDE3 .LT. 4) CALL BADANG(INC2,NODE2,INC3,NODE3,2,3,1)        00002110
      IF(JGIDE3 .EQ. 4) CALL BADANG(INC2,NODE2,INC3,NODE3,2,3,0)        00002120
C                                                                       00002130
C***UNITIZE VECTOR R FOR USE IN ROUTINE INSERT                          00002140
      RMAG = DSQRT(R(1)**2 + R(2)**2 + R(3)**2)                         00002150
      DO 35 KAY=1,3                                                     00002160
  35  R(KAY) = R(KAY) / RMAG                                            00002170
C                                                                       00002180
C***DO MANEUVER CALC.'S, COMPUTE ELEMENTS, TIMES, ATTITUDES FOR ORBS 2&300002190
      CALL INSERT (JINS2,JGIDE2,JAPS2,A1,E1,INC1,NODE1,ARGP1,ANOM1,     00002200
     2             R,A2,E2,INC2,NODE2,ARGP2,ANOM2,DV2,S2B,ARGPI2,       00002210
     3             THETA2,BETA2,TA1,JREL3)                              00002220
      CALL INSERT (JINS3,JGIDE3,JAPS3,A2,E2,INC2,NODE2,ARGP2,ANOM2,     00002230
     2             R,A3,E3,INC3,NODE3,ARGP3,ANOM3,DV3,S3B,ARGPI3,       00002240
     3             THETA3,BETA3,TA2,0)                                  00002250
C                                                                       00002260
C***WRITE OUT ORBITAL INFORMATION SUMMARY TABLE. ANGLES IN DEGREES.     00002270
      CALL DEGRAD (0,XI2,XNOD2,AOP2,TRUE2,INC2,NODE2,ARGP2,ANOM2)       00002280
      CALL DEGRAD (0,XI3,XNOD3,AOP3,TRUE3,INC3,NODE3,ARGP3,ANOM3)       00002290
      IF ((MORB .EQ. 0) .OR. (JJJ .NE. JSDAY))  GO TO 200               00002300
      IF ((MOFLAG .EQ. 0) .AND. (JY .NE. 1) .AND. (JY .NE. JN))GO TO 20000002310
      CALL OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN,NODE)                 00002320
      CALL OUTELM (MORB,1,ELM(1),ELM(2),ELM(3),ELM(4),ELM(5),ELM(6))    00002330
      CALL OUTSET (MORB,1,2,JAPS2,S2B)                                  00002340
      CALL OUTELM (MORB,2,A2,E2,XI2,XNOD2,AOP2,TRUE2)                   00002350
      CALL OUTSET (MORB,2,3,JAPS3,S3B)                                  00002360
      CALL OUTELM (MORB,3,A3,E3,XI3,XNOD3,AOP3,TRUE3)                   00002370
C                                                                       00002380
C*****CONSTRAINT ANALYSIS.*****                                         00002390
  200 TPASS = DAY + TIME/24.D0                                          00002400
      CALL LAUCON (MODE,1,JSDAY,DAY,TIME,STAY1,A1,E1,INC1,NODE1,ARGP1,  00002410
     2                              ANOM1,P1,TPASS,  V   ,TESSO1,ARC1,  00002420
     3                              KCAN1,KREVS1,JUMB1,JPEN1,S1C,S,N)   00002430
      CALL DATOUT (DAY,0.D0,DATE2,XM,1)                                 00002440
      TIN2 = TIME                                                       00002450
      CALL LAUCON (MODE,2,JSDAY,DAY,TIME,STAY2,A2,E2,INC2,NODE2,ARGP2,  00002460
     2                              ANOM2,P2,TPASS,DELV12,TESSO2,ARC2,  00002470
     3                              KCAN2,KREVS2,JUMB2,JPEN2,S2C,S,N)   00002480
      CALL DATOUT(DAY,0.D0,DATE3,XM,1)                                  00002490
      TIN3 = TIME                                                       00002500
      STAY3 = FRAC3 * TWOPI * DSQRT((A3**3.)/U) / 60.D0                 00002510
      CALL LAUCON (MODE,3,JSDAY,DAY,TIME,STAY3,A3,E3,INC3,NODE3,ARGP3,  00002520
     2                              ANOM3,P3,TPASS,DELV23,TESSO3,ARC3,  00002530
     3                              KCAN3,KREVS3,JUMB3,JPEN3,S3C,S,N)   00002540
C                                                                       00002550
C***OUTPUT (UNITS--MINUTES, KM, KM/SEC, DEGREES)                        00002560
C     FILL IN THOSE ELEMENTS OF THE S1,S2,S3,ARRAYS THAT MUST NOT APPEAR00002570
C       IN EQUIVALENCE STATEMENTS.                                      00002580
      S(1)   = DATE                                                     00002590
      S(2)   = TIN                                                      00002600
      S(11)  = GMTL                                                     00002610
      S(103) = A2                                                       00002620
      S(203) = A3                                                       00002630
      JX = (JJJ-JSDAY)/JDATE + 1                                        00002640
      CALL SPILL (S, N, JX, JM*(JY-1)+JX, JM*JN, JAV)                   00002650
C                                                                       00002660
C***BEFORE RETURNING TO TOP OF SCANS FOR NEXT SCANPOINT, RESET NEEDED   00002670
C     VARIABLES TO THEIR ORIGINAL INPUT VALUES.                         00002680
      IF ((JSCAN .EQ. 1).AND.(JJJ .NE. JFDAY)) GO TO 300                00002690
      NODE2=SAVN2                                                       00002700
      NODE3=SAVN3                                                       00002710
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) A2=SAVA2                     00002720
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) A3=SAVA3                     00002730
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) INC2=SAVI2                   00002740
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) INC3=SAVI3                   00002750
  300 CONTINUE                                                          00002760
C$C$  JX = ELAPSE + 1.00001D0                                           00002770
C$C$  CALL TABLES (H,JX,JY,JAV)  ***BUT SEND H THRU COMMON, MAYBE ***   00002780
      RETURN                                                            00002790
      END                                                               00002800
C          DATA SET MODE4      AT LEVEL 001 AS OF 11/08/78              00000000
      SUBROUTINE MODE4(MODE)                                            00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****DRIVER ROUTINE FOR MODE=4                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MODE4 (MODE)                                           00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MODE4 IS TO SERVE AS THE DRIVER ROUTINE FOR        00000100
C     MISSIONS INVOLVING FOUR ORBITS (E.G. PARKING, TRANSFER, DRIFT,    00000110
C     AND SYNCHRONOUS), ALL OF WHICH MAY BE SUBJECT TO CONSTRAINTS.     00000120
C         SCANS ARE CARRIED OUT OVER LAUNCH DATE AND EITHER NODE OR     00000130
C         LAUNCH TIME.                                                  00000140
C                                                                       00000150
C                                                                       00000160
C                                                                       00000170
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000180
C                                                                       00000190
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000200
C                                                                       00000210
C          MODE      I*4      I      PROGRAM MODE                       00000220
C                                                                       00000230
C                                                                       00000240
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MODE4.                    00000250
C                                                                       00000260
C         BADANG    GEOM      LATIME    OUTELM    RECEL     SUNEPH      00000270
C         DATOUT    INPUT4    LAUCON    OUTHED    ROT2XY    TIMEC       00000280
C         DEGRAD    INSERT    NODROT    OUTSET    SPILL     TITLE4      00000290
C         ELMREC                                                        00000300
C                                                                       00000310
C                                                                       00000320
C     MODE4 IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000330
C                                                                       00000340
C         MAIN                                                          00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000390
C                                                                       00000400
C         COMMON VARIABLES USED                                         00000410
C                                                                       00000420
C         A4        DNODE     JDATE     JPEN3     KCAN3(20) NODE4       00000430
C         ANOM4     DTIME     JGIDE2    JPEN4     KCAN4(20) SDATE       00000440
C         ARC1      E4        JGIDE3    JSCAN     KREVS1    SNODE       00000450
C         ARC2      FDATE     JINS2     JUMB1     KREVS2    STIME       00000460
C         ARC3      FNODE     JINS3     JUMB2     KREVS3    TESSO1      00000470
C         ARC4      FRAC3     JNOD2     JUMB3     KREVS4    TESSO2      00000480
C         ARGP4     FRAC4     JNOD3     JUMB4     MOFLAG    TESSO3      00000490
C         DNMAX2    FTIME     JPEN1     KCAN1(20) MORB      TESSO4      00000500
C         DNMAX3    INC4      JPEN2     KCAN2(20) MSUN      TLINJ       00000510
C                                                                       00000520
C         COMMON VARIABLES USED AND COMPUTED                            00000530
C                                                                       00000540
C         A2        DV2       INC2      NODE2                           00000550
C         A3        DV3       INC3      NODE3                           00000560
C                                                                       00000570
C                                                                       00000580
C                                                                       00000590
C*****INPUTS ENTER THRU BLOCKS COMMON W/ INPUT4 AND DFALT4 ROUTINES*****00000600
C +++ COMMON /SCANS/                                                    00000610
C     TLINJ               (I) TIME (SECS) BETWEEN LAUNCH TIME AND       00000620
C                             ORBIT 1 INJECTION TIME                    00000630
C     JSCAN               (I) FLAG FOR SCAN OPTION --                   00000640
C                             =1, SCAN OVER NODE. (COMPUTE LAUNCH TIME) 00000650
C                             =2, SCAN OVER LAUNCH TIME. (COMPUTE NODE) 00000660
C     SNODE,FNODE,DNODE   (I) STARTING & FINISHING NODES & INCREMENT OF 00000670
C                             NODE SCAN (RADIANS)                       00000680
C     STIME,FTIME,DTIME   (I) STARTING & FINISHING TIMES & INCREMENT OF 00000690
C                             TIME SCAN (HOURS)                         00000700
C     SDATE,FDATE,JDATE   (I) STARTING & FINISHING CALENDAR DATES       00000710
C                             (YYMM.DD) & INTEGER INCREMENT OF DATE SCAN00000720
C                                                                       00000730
C +++ COMMON /TWO/ (FOR ORBIT 2) & COMMON /THREE/ (FOR ORBIT 3) --      00000740
C                   ++(SEE ALSO INSERT,DVEL,NODROT DESCRIPTIONS)++      00000750
C     A2,DV2,INC2,        (I/O, DEPENDING ON JGIDE) --                  00000760
C     A3,DV3,INC3               SEMIMAJOR AXES (KM), MANEUVER VELOCITY  00000770
C                               MAGNITUDES (KM/S), INCLINATIONS (RADS)  00000780
C     NODE2,NODE3         (I/O, DEPENDING ON JNOD & JGIDE) --           00000790
C                               ASCENDING NODES (RADIANS)               00000800
C     DNMAX2,DNMAX3       (I) NODE ROTATIONS (RADS) (SEE NODROT ROUTINE)00000810
C     JGIDE2,JGIDE3       (I) FLAGS FOR CHOOSING MANEUVR GUIDANCE OPTION00000820
C     JNOD2,JNOD3         (I) FLAGS FOR CHOOSING NODE ROTATION OPTION   00000830
C     JINS2,JINS3         (I) FLAGS FOR CHOOSING INSERTION POINTS       00000840
C     ARGPI2, ARGPI3      (I) ARGUMENTS OF PERIGEE                      00000850
C     TA1,TA2             (I) TRUE ANOMALY IN OLD ORBIT AT WHICH        00000860
C                             INSERTION INTO NEW ORBIT OCCURS           00000870
C     THETA2,BETA2        (I) DECLINATION AND RIGHT ASCENSION ANGLES    00000880
C     THETA3,BETA3            DEFINING THE DELTAV VECTOR IN THE LOCAL   00000890
C                             TANGENT SYSTEM                            00000900
C                                                                       00000910
C +++ COMMON /FOUR/ -- KEPLERIAN ELEMENTS OF ORBIT 4                    00000920
C     A4                  (I) SEMIMAJOR AXIS (KM)                       00000930
C     E4                  (I) ECCENTRICITY                              00000940
C     INC4                (I) INCLINATION (RADIANS)                     00000950
C     NODE4               (I) RIGHT ASCENSION OF ASCENDING NODE (RADS)  00000960
C     ARGP4               (I) ARGUMENT OF PERIGEE (RADIANS)             00000970
C     ANOM4               (I) TRUE ANOMALY (RADIANS)                    00000980
C                                                                       00000990
C +++ COMMON /ONECAN/, /TWOCAN/, /THRCAN/, /FOURCA/ (ORBS 1,2,3,4)      00001000
C                   ++(SEE ALSO LAUCON DESCRIPTION)++                   00001010
C     TESSO1,...,TESSO4   (I) TIMES USED IN EARTH-SAT-SUN ANGLE ANALYSIS00001020
C     ARC1,...,ARC4       (I) ANALYZE SHADOWS ALONG THESE ARCS          00001030
C     KCAN1(20),...,4(20) (I) FLAGS FOR CHOOSING CONSTRAINT ANALYSES    00001040
C     KREVS1,...,KREVS4   (I) NO. OF EXTRA REVS IN EACH ORBIT           00001050
C     JUMB1,...,JUMB4     (I) FLAGS FOR UMBRAL SHADOW ANALYSIS          00001060
C     JPEN1,...,JPEN4     (I) FLAGS FOR PENUMBRAL SHADOW ANALYSIS       00001070
C     FRAC3 (ORB 3 ONLY)  (I) TIME FRACTION OF A FULL REV (.GE. 0., .LE.00001080
C                             1.) WHICH SAT. IS CONSIDERED TO SPEND IN 300001090
C     FRAC4 (ORB 4 ONLY)  (I) TIME FRACTION OF A FULL REV (.GE. 0., .LE.00001100
C                             1.) WHICH SAT. IS CONSIDERED TO SPEND IN 400001110
C                                                                       00001120
C +++ COMMON /ORBOUT/                                                   00001130
C     MSUN                (I) PRINTER UNIT FOR SUN EPHEMERIS (INTEGER)  00001140
C     MORB                (I) PRINTER UNIT FOR ORBITAL INFO. SUMMARY    00001150
C                             TABLE (INTEGER)                           00001160
C     MOFLAG              (I) PRINT ORB. INFO. SUMMARY TABLE --         00001170
C                             (.EQ. 0) FOR 1ST & LAST NODE/TIME IN SCAN 00001180
C                             (.NE. 0) FOR EVERY NODE/TIME IN THE SCAN  00001190
C                                                                       00001200
C*****OUTPUTS ARE PASSED THRU ARRAY S(400) TO THE 'SPILL' ROUTINE.      00001210
C     ALL OUTPUT ANGLES ARE IN DEGREES.                                 00001220
C                                                                       00001230
C                                                                       00001240
      REAL*8 INC1,NODE1,INC2,NODE2,INC3,NODE3,INC4,NODE4,NODE           00001250
      COMMON/SCANS/TLINJ,SNODE,FNODE,DNODE,STIME,FTIME,DTIME,           00001260
     2             SDATE,FDATE,JDATE,JSCAN                              00001270
      COMMON/TWO/ A2,DV2, INC2, NODE2,DNMAX2,ARGPI2,THETA2,BETA2,TA1,   00001280
     *            JGIDE2,JNOD2,JINS2,JREL3                              00001290
      COMMON/THREE/ A3,DV3, INC3, NODE3,DNMAX3,ARGPI3,THETA3,BETA3,TA2, 00001300
     *              JGIDE3,JNOD3,JINS3                                  00001310
      COMMON/FOUR/A4,E4,INC4,NODE4,ARGP4,ANOM4                          00001320
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00001330
      COMMON/TWOCAN/TESSO2,ARC2,KCAN2(20),KREVS2,JUMB2,JPEN2            00001340
      COMMON/THRCAN/FRAC3,TESSO3,ARC3,KCAN3(20),KREVS3,JUMB3,JPEN3      00001350
      COMMON/FOURCA/FRAC4,TESSO4,ARC4,KCAN4(20),KREVS4,JUMB4,JPEN4      00001360
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00001370
      DIMENSION REL(3),VES(3),R(3),V(3),DELV12(3),DELV23(3),ELM(6)      00001380
      DIMENSION R4(3),V4(3)                                             00001390
      DIMENSION S1C(50),S2B(30),S2C(50),S3B(30),S3C(50),S4C(50),S(400)  00001400
      EQUIVALENCE (ELM(1),A1),          (ELM(2),E1)                     00001410
      EQUIVALENCE (S2B(11),DELV12(1)), (S2B(4),STAY1)                   00001420
      EQUIVALENCE (S3B(11),DELV23(1)), (S3B(4),STAY2)                   00001430
C                                                                       00001440
C***FILL IN ELEMENTS OF OUTPUT ARRAYS. (MISSING ARE ELEMENTS THAT APPEAR00001450
C     IN COMMON -- THEY'RE FILLED IN NEAR THE END OF THIS SUBROUTINE.)  00001460
      EQUIVALENCE (S(3),ELM(1)),   (S(9),P1),       (S(10),ELAPSE),     00001470
     2            (S(51),S1C(1))                                        00001480
      EQUIVALENCE (S(101),DATE2),  (S(102),TIN2),   (S(104),E2),        00001490
     2            (S(105),XI2),    (S(106),XNOD2),  (S(107),AOP2),      00001500
     3            (S(108),TRUE2),  (S(109),P2),                         00001510
     4            (S(121),S2B(1)), (S(151),S2C(1))                      00001520
      EQUIVALENCE (S(201),DATE3),  (S(202),TIN3),   (S(204),E3),        00001530
     2            (S(205),XI3),    (S(206),XNOD3),  (S(207),AOP3),      00001540
     3            (S(208),TRUE3),  (S(209),P3),                         00001550
     4            (S(221),S3B(1)), (S(251),S3C(1))                      00001560
      EQUIVALENCE (S(301),DATE4),  (S(302),TIN4),                       00001570
     2            (S(305),XI4),    (S(306),XNOD4),  (S(307),AOP4),      00001580
     3            (S(308),TRUE4),  (S(309),P4),     (S(351),S4C(1))     00001590
      DATA U,TWOPI/ 398600.8D0, 6.283185307179586D0/                    00001600
C                                                                       00001610
C***READ INPUTS. STORE VALUES THAT MAY UNDERGO INTERNAL CHANGES.        00001620
      CALL INPUT4                                                       00001630
      SAVN2 = NODE2                                                     00001640
      SAVN3 = NODE3                                                     00001650
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVA2=A2                     00001660
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) SAVA3=A3                     00001670
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) SAVI2=INC2                   00001680
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) SAVI3=INC3                   00001690
C                                                                       00001700
C***SET UP DIRECT-ACCESS STORAGE FOR OUTPUT.                            00001710
C$C$  DEFINE FILE 50(5929,300,U,JAV)                                    00001720
      JAV = 1                                                           00001730
C                                                                       00001740
C***SET UP PRINTER OUTPUT.                                              00001750
      CALL TITLE4 (MODE,N)                                              00001760
C                                                                       00001770
C***DETERMINE ORIENTATION OF ORBIT 1 W.R.T. COORDS ROTATING W/ THE EARTH00001780
      CALL GEOM (OMEGA,REL,VES)                                         00001790
C                                                                       00001800
C***SET UP INTEGER LIMITS TO DATE SCAN IN TERMS OF DAYS SINCE 1950.0.   00001810
      CALL TIMEC (SDATE,0.D0,DAY,XM)                                    00001820
      JSDAY = DAY                                                       00001830
      CALL TIMEC (FDATE,0.D0,DAY,XM)                                    00001840
      JFDAY = DAY                                                       00001850
      JM = (JFDAY-JSDAY)/JDATE + 1                                      00001860
C                                                                       00001870
C***COMPUTE A SUN POSITION EPHEMERIS AT 12 HR INTERVALS STARTING AT 0 HR00001880
C     ON SDATE AND ENDING AT 12 HR ON 10TH DAY AFTER FDATE.             00001890
      CALL SUNEPH (MSUN, JSDAY, JFDAY-JSDAY+10)                         00001900
C                                                                       00001910
C***COUNT UP NUMBER OF NODES OR TIMES IN THE NODE OR TIME SCAN.         00001920
      IF (JSCAN .EQ. 1) JN = (FNODE-SNODE)/DNODE + 1.00001D0            00001930
      IF (JSCAN .EQ. 2) JN = (FTIME-STIME)/DTIME + 1.00001D0            00001940
C                                                                       00001950
C***********************NODE OR TIME SCAN***********************        00001960
C                                                                       00001970
      DO 300 JY=1,JN                                                    00001980
      IF (JSCAN .EQ. 1) NODE = SNODE + (JY-1)*DNODE                     00001990
      IF (JSCAN .EQ. 2) GMTL = STIME + (JY-1)*DTIME                     00002000
C                                                                       00002010
C***********************DATE SCAN************************               00002020
C                                                                       00002030
      DO 300 JJJ = JSDAY, JFDAY, JDATE                                  00002040
      ELAPSE = JJJ - JSDAY                                              00002050
      DAY=JJJ                                                           00002060
C                                                                       00002070
C***DETERMIN INJ TIME, GR'NWICH HOUR ANGLE, & EITHER LAUNCH TIME OR NODE00002080
      CALL LATIME(JSCAN,TLINJ,OMEGA,DAY,NODE,GMTL,TIME,HA)              00002090
      CALL DATOUT(DAY,0.D0,DATE,XM,1)                                   00002100
      TIN=TIME                                                          00002110
      IF ((JSCAN .EQ. 1) .AND. (JJJ .NE. JSDAY)) GO TO 200              00002120
C                                                                       00002130
C***ROTATE INJ. POS. & VEL. VECTORS FROM GREENWICH INTO EQUINOX COORDS  00002140
      CALL ROT2XY(HA,REL,R)                                             00002150
      CALL ROT2XY(HA,VES,V)                                             00002160
C                                                                       00002170
C***CONVERT ORBIT 1 FROM CARTESIAN COORDINATES TO KEPLERIAN ELEMENTS    00002180
      CALL RECEL (U,R,V,TFP,ELM,XM)                                     00002190
      CALL DEGRAD (1,ELM(3),ELM(4),ELM(5),ELM(6),INC1,NODE1,ARGP1,ANOM1)00002200
C                                                                       00002210
C***NODE ANGLES OF ORBS 2 & 3 DEPEND ON NODE ROTATION OPTION.           00002220
      CALL NODROT(JNOD2,NODE1,NODE2,DNMAX2)                             00002230
      CALL NODROT(JNOD3,NODE2,NODE3,DNMAX3)                             00002240
C                                                                       00002250
C***CHECK FOR PROBLEMATIC INCLINATIONS OR NODES                         00002260
      IF(JGIDE2 .LT. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,1)        00002270
      IF(JGIDE2 .EQ. 4) CALL BADANG(INC1,NODE1,INC2,NODE2,1,2,0)        00002280
      IF(JGIDE3 .LT. 4) CALL BADANG(INC2,NODE2,INC3,NODE3,2,3,1)        00002290
      IF(JGIDE3 .EQ. 4) CALL BADANG(INC2,NODE2,INC3,NODE3,2,3,0)        00002300
C                                                                       00002310
C***UNITIZE VECTOR R FOR USE IN ROUTINE INSERT                          00002320
      RMAG = DSQRT(R(1)**2 + R(2)**2 + R(3)**2)                         00002330
      DO 35 KAY=1,3                                                     00002340
  35  R(KAY) = R(KAY) / RMAG                                            00002350
C                                                                       00002360
C***DO MANEUVER CALC.'S, COMPUTE ELEMENTS, TIMES, ATTITUDES FOR ORBS 2&300002370
      CALL INSERT (JINS2,JGIDE2,JAPS2,A1,E1,INC1,NODE1,ARGP1,ANOM1,     00002380
     2             R,A2,E2,INC2,NODE2,ARGP2,ANOM2,DV2,S2B,ARGPI2,       00002390
     3             THETA2,BETA2,TA1,JREL3)                              00002400
      CALL INSERT (JINS3,JGIDE3,JAPS3,A2,E2,INC2,NODE2,ARGP2,ANOM2,     00002410
     2             R,A3,E3,INC3,NODE3,ARGP3,ANOM3,DV3,S3B,ARGPI3,       00002420
     3             THETA3,BETA3,TA2,0)                                  00002430
C                                                                       00002440
C***WRITE OUT ORBITAL INFORMATION SUMMARY TABLE. ANGLES IN DEGREES.     00002450
      CALL DEGRAD (0,XI2,XNOD2,AOP2,TRUE2,INC2,NODE2,ARGP2,ANOM2)       00002460
      CALL DEGRAD (0,XI3,XNOD3,AOP3,TRUE3,INC3,NODE3,ARGP3,ANOM3)       00002470
      CALL DEGRAD (0,XI4,XNOD4,AOP4,TRUE4,INC4,NODE4,ARGP4,ANOM4)       00002480
      IF ((MORB .EQ. 0) .OR. (JJJ .NE. JSDAY))  GO TO 200               00002490
      IF ((MOFLAG .EQ. 0) .AND. (JY .NE. 1) .AND. (JY .NE. JN))GO TO 20000002500
      CALL OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN,NODE)                 00002510
      CALL OUTELM (MORB,1,ELM(1),ELM(2),ELM(3),ELM(4),ELM(5),ELM(6))    00002520
      CALL OUTSET (MORB,1,2,JAPS2,S2B)                                  00002530
      CALL OUTELM (MORB,2,A2,E2,XI2,XNOD2,AOP2,TRUE2)                   00002540
      CALL OUTSET (MORB,2,3,JAPS3,S3B)                                  00002550
      CALL OUTELM (MORB,3,A3,E3,XI3,XNOD3,AOP3,TRUE3)                   00002560
      CALL OUTELM (MORB,4,A4,E4,XI4,XNOD4,AOP4,TRUE4)                   00002570
C                                                                       00002580
C*****CONSTRAINT ANALYSIS.*****                                         00002590
  200 TPASS = DAY + TIME/24.D0                                          00002600
      CALL LAUCON (MODE,1,JSDAY,DAY,TIME,STAY1,A1,E1,INC1,NODE1,ARGP1,  00002610
     2                              ANOM1,P1,TPASS,  V   ,TESSO1,ARC1,  00002620
     3                              KCAN1,KREVS1,JUMB1,JPEN1,S1C,S,N)   00002630
      CALL DATOUT (DAY,0.D0,DATE2,XM,1)                                 00002640
      TIN2 = TIME                                                       00002650
      CALL LAUCON (MODE,2,JSDAY,DAY,TIME,STAY2,A2,E2,INC2,NODE2,ARGP2,  00002660
     2                              ANOM2,P2,TPASS,DELV12,TESSO2,ARC2,  00002670
     3                              KCAN2,KREVS2,JUMB2,JPEN2,S2C,S,N)   00002680
      CALL DATOUT(DAY,0.D0,DATE3,XM,1)                                  00002690
      TIN3 = TIME                                                       00002700
      STAY3 = FRAC3 * TWOPI * DSQRT((A3**3.)/U) / 60.D0                 00002710
      CALL LAUCON (MODE,3,JSDAY,DAY,TIME,STAY3,A3,E3,INC3,NODE3,ARGP3,  00002720
     2                              ANOM3,P3,TPASS,DELV23,TESSO3,ARC3,  00002730
     3                              KCAN3,KREVS3,JUMB3,JPEN3,S3C,S,N)   00002740
C *** THE ASSUMPTION IS MADE THAT ORBIT 4 INSERTION OCCURS              00002750
C     (FRAC3+KREVS3)*P3 MINUTES AFTER ORBIT 3 INSERTION, AND THAT DURING00002760
C     THE TIME PERIOD KREVS3*P3, UNSIMULATED MANEUVERS ARE PERFORMED    00002770
C     WHICH ALLOW THE SATELLITE TO ENTER ORBIT 4 AT A TRUE ANOMALY GIVEN00002780
C     BY THE USER-CHOSEN INPUT VALUE OF ANOM4.  THESE ASSUMPTIONS ARE   00002790
C     CLEARLY ONLY TEMPORARY EXPEDIENCIES. REFINEMENT OF THIS PART OF   00002800
C     THE PROGRAM WILL UNDOUBTEDLY BE NECESSARY.                        00002810
      CALL DATOUT (DAY,0.D0,DATE4,XM,1)                                 00002820
      TIN4 = TIME                                                       00002830
      STAY4 = FRAC4 * TWOPI * DSQRT((A4**3.)/U) / 60.D0                 00002840
      CALL ELMREC (A4,E4,INC4,NODE4,ARGP4,ANOM4,V4,XM,0,R4,RMAG)        00002850
      CALL LAUCON (MODE,4,JSDAY,DAY,TIME,STAY4,A4,E4,INC4,NODE4,ARGP4,  00002860
     2                              ANOM4,P4,TPASS,  V4  ,TESSO4,ARC4,  00002870
     3                              KCAN4,KREVS4,JUMB4,JPEN4,S4C,S,N)   00002880
C                                                                       00002890
C***OUTPUT (UNITS--MINUTES, KM, KM/SEC, DEGREES)                        00002900
C     FILL IN THOSE ELEMENTS OF THE S ARRAY THAT MUST NOT APPEAR        00002910
C       IN EQUIVALENCE STATEMENTS.                                      00002920
      S(1)   = DATE                                                     00002930
      S(2)   = TIN                                                      00002940
      S(11)  = GMTL                                                     00002950
      S(103) = A2                                                       00002960
      S(203) = A3                                                       00002970
      S(303) = A4                                                       00002980
      S(304) = E4                                                       00002990
      JX = (JJJ-JSDAY)/JDATE + 1                                        00003000
      CALL SPILL (S, N, JX, JM*(JY-1)+JX, JM*JN, JAV)                   00003010
C                                                                       00003020
C***BEFORE RETURNING TO TOP OF SCANS FOR NEXT SCANPOINT, RESET NEEDED   00003030
C     VARIABLES TO THEIR ORIGINAL INPUT VALUES.                         00003040
      IF ((JSCAN .EQ. 1).AND.(JJJ .NE. JFDAY)) GO TO 300                00003050
      NODE2=SAVN2                                                       00003060
      NODE3=SAVN3                                                       00003070
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) A2=SAVA2                     00003080
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) A3=SAVA3                     00003090
      IF(JGIDE2 .EQ. 3 .OR. JGIDE2 .EQ. 4) INC2=SAVI2                   00003100
      IF(JGIDE3 .EQ. 3 .OR. JGIDE3 .EQ. 4) INC3=SAVI3                   00003110
  300 CONTINUE                                                          00003120
C$C$  JX = ELAPSE + 1.00001D0                                           00003130
C$C$  CALL TABLES (H,JX,JY,JAV)  ***BUT SEND H THRU COMMON, MAYBE ***   00003140
      RETURN                                                            00003150
      END                                                               00003160
C          DATA SET MODE5      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE5 (MODE)                                           00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C*****DRIVER ROUTINE FOR MODE=5                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MODE5 (MODE)                                           00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MODE5 IS TO SERVE AS THE DRIVER ROUTINE WHEN       00000100
C         CONSTRAINED-PARAMETER ANALYSIS FOR ONLY ONE ORBIT IS DESIRED. 00000110
C         THE ORBIT IS INPUT IN TERMS OF ITS KEPLERIAN ELEMENTS AT A    00000120
C         GIVEN TIME. ONLY A DATE SCAN IS CARRIED OUT.                  00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENTS   TYPE   I/O        DEFINITION                      00000190
C                                                                       00000200
C          MODE       I*4     I      PROGRAM MODE                       00000210
C                                                                       00000220
C                                                                       00000230
C                                                                       00000240
C     MODE5 IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000250
C                                                                       00000260
C         MAIN                                                          00000270
C                                                                       00000280
C                                                                       00000290
C                                                                       00000300
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MODE5.                    00000310
C                                                                       00000320
C         BADANG    DEGRAD    INPUT5    OUTELM    SUNEPH    TITLE5      00000330
C         DATOUT    ELMREC    LAUCON    SPILL     TIMEC                 00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000380
C                                                                       00000390
C         COMMON VARIABLES USED                                         00000400
C                                                                       00000410
C         A1        E1        JPEN1     MORB      SDATE                 00000420
C         ANOM1     FDATE     JUMB1     MSUN      TESSO1                00000430
C         ARC1      INC1      KCAN1(20) NODE1     TIME                  00000440
C         ARGP1     JDATE     KREVS1                                    00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
C*****INPUTS THRU COMMON*****                                           00000490
C     /ONETWO/ -- KEPLERIAN ELEMENTS AT INSERTION. (UNITS--KM,RADIANS.) 00000500
C     /ONECAN/ -- LAUNCH WINDOW ANALYSIS PARAMETERS (SEE LAUCON ROUTINE)00000510
C     /SCANS5/  --                                                      00000520
C        SDATE,FDATE (YYMM.DD) ARE STARTING, FINISHING DATES OF SCAN.   00000530
C        JDATE IS INCREMENT OF DATE SCAN (INTEGER).                     00000540
C        TIME (HRS) IS INSERTION TIME, WHICH IN MODE 5 IS CONSIDERED TO 00000550
C             BE INDEPENDENT OF NODE.  (THIS MEANS GEOGRAPHIC LONGITUDE 00000560
C             OF INSERTION IS NOW A DEPENDENT QUANTITY.)                00000570
C     /ORBOUT/ --                                                       00000580
C        MSUN IS UNIT NUMBER FOR PRINTING SUN EPHEMERIS.                00000590
C        MORB IS ORBITAL INFORMATION OUTPUT UNIT NUMBER.                00000600
C        MOFLAG IS NOT USED IN MODE5.                                   00000610
C                                                                       00000620
C                                                                       00000630
      REAL*8 INC1,NODE1,I1,NOD1                                         00000640
      COMMON/ONETWO/A1,E1,INC1,NODE1,ARGP1,ANOM1                        00000650
      COMMON/ONECAN/TESSO1,ARC1,KCAN1(20),KREVS1,JUMB1,JPEN1            00000660
      COMMON/SCANS5/TIME, SDATE,FDATE,JDATE                             00000670
      COMMON/ORBOUT/MSUN,MORB,MOFLAG                                    00000680
      DIMENSION R(3),V(3),S1(100),S1C(50)                               00000690
C***FILL IN OUTPUT ARRAY.                                               00000700
      EQUIVALENCE (S1(1),DATE),    (S1(2),TIN),     (S1(5),I1),         00000710
     2            (S1(6),NOD1),    (S1(7),AOP1),    (S1(8),TRUE1),      00000720
     3            (S1(9),P1),      (S1(10),ELAPSE),                     00000730
     4            (S1(51),S1C(1))                                       00000740
      DATA U,TWOPI/ 398600.8D0,6.283185307179586D0/                     00000750
      S1(3) = A1                                                        00000760
      S1(4) = E1                                                        00000770
C                                                                       00000780
C***READ INPUTS. SET UP PRINTER OUTPUT.                                 00000790
      CALL INPUT5                                                       00000800
      CALL BADANG (DUMMY,DUMMY,INC1,NODE1,0,1,0)                        00000810
      CALL TITLE5 (MODE,N)                                              00000820
      JLINES = 0                                                        00000830
C$C$  DEFINE FILE 50(5929,100,U,JAV)                                    00000840
      JAV = 1                                                           00000850
C***PRELIMINARIES TO DATE SCAN.                                         00000860
      CALL TIMEC (SDATE,0.D0,SDAY,DUMMY)                                00000870
      JSDAY = SDAY                                                      00000880
      CALL TIMEC (FDATE,0.D0,FDAY,DUMMY)                                00000890
      JFDAY = FDAY                                                      00000900
C***COMPUTE A SUN POSITION EPHEMERIS AT 12 HR INTERVALS STARTING AT 0 HR00000910
C     ON SDATE AND ENDING AT 12 HR ON 10TH DAY AFTER FDATE.             00000920
      JDAY = JFDAY + 10 - JSDAY                                         00000930
      CALL SUNEPH (MSUN,JSDAY,JDAY)                                     00000940
C                                                                       00000950
C***FIND POSITION & VELOCITY VECTORS (EQUINOX COORDS) AT INSERTION PT.  00000960
      CALL ELMREC (A1,E1,INC1,NODE1,ARGP1,ANOM1,V,VMAG,2,R,RMAG)        00000970
      CALL DEGRAD (0,I1,NOD1 ,AOP1,TRUE1,INC1,NODE1,ARGP1,ANOM1)        00000980
      IF (MORB .NE. 0) WRITE (MORB,1001)                                00000990
      IF (MORB .NE. 0) CALL OUTELM (MORB,1,A1,E1,I1,NOD1,AOP1,TRUE1)    00001000
      STAY1 =(TWOPI * DSQRT((A1**3.)/U) / 60.D0 )                       00001010
C                                                                       00001020
C***SCAN OVER INSERTION DATES.***                                       00001030
C                                                                       00001040
      DO 300 JJJ = JSDAY,JFDAY,JDATE                                    00001050
      ELAPSE = JJJ - JSDAY                                              00001060
      DAY = JJJ                                                         00001070
      CALL DATOUT (DAY,0.D0,DATE,DUMMY,1)                               00001080
      TIN = TIME                                                        00001090
C * CONSTRAINT ANALYSIS.                                                00001100
C     (NOTE--SATELLITE SPIN AXIS IS ASSUMED TO BE (+ OR -) V)           00001110
      TPASS = DAY + TIME/24.D0 - STAY1*0.D0                             00001120
      CALL LAUCON (MODE,1,JSDAY,DAY,TIME,STAY1,A1,E1,INC1,NODE1,ARGP1,  00001130
     2  ANOM1,P1,TPASS,V,TESSO1,ARC1,KCAN1,KREVS1,JUMB1,JPEN1,S1C,S,N)  00001140
      TIME = TIN                                                        00001150
C * OUTPUT (UNITS--MINUTES, KM, KM/SEC, DEGREES)                        00001160
      JLINES = JLINES + 1                                               00001170
      CALL SPILL (S1, N, JLINES, JLINES, (JFDAY-JSDAY)/JDATE+1, JAV)    00001180
  300 CONTINUE                                                          00001190
      RETURN                                                            00001200
 1001 FORMAT (1H1,'*****************************************************00001210
     2****ORBIT INFORMATION*********************************************00001220
     3*********'//' ',63X,'MODE=5'//)                                   00001230
      END                                                               00001240
C          DATA SET MODE6      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE6(MODE)                                            00000010
      IMPLICIT REAL*8(A-I,L,N-Z)                                        00000020
      WRITE (6,1001) MODE                                               00000030
      RETURN                                                            00000040
 1001 FORMAT (1H1, 'MODE=',I3)                                          00000050
      END                                                               00000060
C          DATA SET MODE7      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE7(MODE)                                            00000010
      IMPLICIT REAL*8(A-I,L,N-Z)                                        00000020
      WRITE (6,1001) MODE                                               00000030
      RETURN                                                            00000040
 1001 FORMAT (1H1, 'MODE=',I3)                                          00000050
      END                                                               00000060
C          DATA SET MODE8      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE8(MODE)                                            00000010
      IMPLICIT REAL*8(A-I,L,N-Z)                                        00000020
      WRITE (6,1001) MODE                                               00000030
      RETURN                                                            00000040
 1001 FORMAT (1H1, 'MODE=',I3)                                          00000050
      END                                                               00000060
C          DATA SET MODE9      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MODE9(MODE)                                            00000010
      IMPLICIT REAL*8(A-I,L,N-Z)                                        00000020
      WRITE (6,1001) MODE                                               00000030
      RETURN                                                            00000040
 1001 FORMAT (1H1, 'MODE=',I3)                                          00000050
      END                                                               00000060
C          DATA SET MVTRN      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE MVTRN(A,B,C,M,N)                                       00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE MVTRN (A,B,C,M,N)                                      00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF MVTRN IS TO COMPUTE THE PRODUCT OF A 3X3 MATRIX AND00000100
C         A 3XN MATRIX.                                                 00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          A(3,3)    R*8      I      PREMATRIX                          00000190
C          B(3,N)    R*8      I      POST-MATRIX                        00000200
C          C(3,N)    R*8      O      MATRIX PRODUCT, A*B OR             00000210
C                                       A(TRANSPOSE)*B                  00000220
C          M         I*4      I      OPTION FLAG --                     00000230
C                                       =1, PREMATRIX IS A              00000240
C                                       =2, PREMATRIX IS A(TRANSPOSE)   00000250
C          N         I*4      I      NUMBER OF COLUMNS OF B AND C       00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     MVTRN IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000300
C                                                                       00000310
C         SHORB2                                                        00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     NO SUBROUTINES ARE CALLED BY MVTRN.                               00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     MVTRN NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000400
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000410
C                                                                       00000420
C                                                                       00000430
C                                                                       00000440
      DIMENSION A(9),B(9),C(9)                                          00000450
      N3 = 3*N                                                          00000460
      GO TO 1                                                           00000470
      ENTRY ROTATE (M,A,B,C)                                            00000480
C        ROTATE DOES MATRIX-VECTOR MULT                                 00000490
      N3 = 3                                                            00000500
1     ASSIGN 2 TO MM                                                    00000510
      IF (M .NE. 1) ASSIGN 3 TO MM                                      00000520
      DO 5 I=1,N3,3                                                     00000530
      B1 = B(I)                                                         00000540
      B2 = B(I+1)                                                       00000550
      B3 = B(I+2)                                                       00000560
      GO TO MM, (2,3)                                                   00000570
C           C = A B                                                     00000580
2     D1 = A(1)*B1 + A(4)*B2 + A(7)*B3                                  00000590
      D2 = A(2)*B1 + A(5)*B2 + A(8)*B3                                  00000600
      D3 = A(3)*B1 + A(6)*B2 + A(9)*B3                                  00000610
      GO TO 4                                                           00000620
C          C = A(TRANSPOSED) B                                          00000630
3     D1 = A(1)*B1 + A(2)*B2 + A(3)*B3                                  00000640
      D2 = A(4)*B1 + A(5)*B2 + A(6)*B3                                  00000650
      D3 = A(7)*B1 + A(8)*B2 + A(9)*B3                                  00000660
4     C(I) = D1                                                         00000670
      C(I+1) = D2                                                       00000680
      C(I+2) = D3                                                       00000690
5     CONTINUE                                                          00000700
      RETURN                                                            00000710
      END                                                               00000720
      SUBROUTINE NODE(INCA,NODEA,INCB,NODEB)                            00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C SUBROUTINE NODE(INCA,NODEA,INCB,NODEB)                                00000040
C                                                                       00000050
C THE PURPOSE OF SUBROUTINE NODE IS TO DETERMINE A TRANSFER ORBIT       00000060
C NODE SUCH THAT APOGEE OF THE TRANSFER ORBIT WILL COINCIDE WITH        00000070
C THE LINE OF RELATIVE NODES BETWEEN THE TRANSFER ORBIT AND THE         00000080
C FINAL DRIFT ORBIT.  IN ORDER TO CALCULATE THIS NODE SUBROUTINE        00000090
C NODE SOVES THE SPHERICAL TRIANGLE FOR REQUIRED NODE ROTATION.         00000100
C                                                                       00000110
C ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.             00000120
C                                                                       00000130
C VARIABLE TYPE I/O DESCRIPTION                                         00000140
C NAME                                                                  00000150
C -------- ---- --- ------------------------------------------------    00000160
C INCA     R*8   I  PARKING ORBIT INCLINATION                           00000170
C NODEA    R*8   I  PARKING ORBIT NODE                                  00000180
C INCB     R*8   I  TRANSFER ORBIT INCLINATION                          00000200
C NODEB    R*8   O  TRANSFER ORBIT NODE                                 00000210
C                                                                       00000220
C NODE IS CALLED BY THE FOLLOWING SUBROUTINES:                          00000230
C       INSERT                                                          00000240
C                                                                       00000250
C NODE CALLS NO SUBROUTINES                                             00000260
C                                                                       00000270
C INSERT USES THE FOLLOWING VARIABLES FROM THE LISTED COMMON BLOCKS     00000280
C                                                                       00000290
C /THREE/ INC3,NODE3                                                    00000300
C                                                                       00000310
      REAL*8 INCA,INCB,NODEA,NODEB,INCC,NODEC                           00000320
      DIMENSION HA(3),HC(3),HL(3),ANUV(3)                               00000330
      COMMON/THREE/A3,DV3,INCC,NODEC,DNMAX3,ARGPI3,THETA3,BETA3,        00000340
     *             TA2,JGIDE3,JNOD3,JINS3                               00000350
      DATA PI/3.1415926535897932D0/                                     00000360
      HPI=PI/2.D0                                                       00000370
      PI2=PI*2.D0                                                       00000380
C CALCULATE ANGULAR MOMENTUM VECTORS FOR PARKING AND DRIFT ORBITS       00000390
      CALL ANGMOM(INCA,NODEA,HA)                                        00000400
      CALL ANGMOM(INCC,NODEC,HC)                                        00000410
C CALCULATE LINE OF RELATIVE NODES BETWEEN PARKING AND DRIFT ORBITS     00000420
      CALL XPROD(HA,HC,HL,HMAG,1)                                       00000430
C CALCULATE UNIT VECTOR POINTING AT ASCENDING NODE OF PARKING ORBIT     00000440
      CALL NODVEC(HA(1),HA(2),ANUV)                                     00000450
C DETERMINE ANGLE BETWEEN INTERSECTION OF LINE OF RELATIVE NODES AND    00000460
CC ASCENDING NODE CROSSING IN PARKING ORBIT.  ANGLE MUST BE BETWEEN     00000470
C ZERO AND PI/2.                                                        00000480
      ANGL=DOT(HL,ANUV)                                                 00000490
      ANGL=DARCOS(ANGL)                                                 00000500
      IF(ANGL.GT.HPI) ANGL=PI-ANGL                                      00000510
C CALCULATE ANGLE BETWEEN INTERSECTION OF LINE OF RELATIVE NODES AND    00000520
C ASCENDING NODE CROSSING IN TRANSFER ORBIT.                            00000530
      PINCA=PI-INCA                                                     00000540
      SPINCA=DSIN(PINCA)                                                00000550
      SARGPA=DSIN(ANGL)                                                 00000560
      SINCB=DSIN(INCB)                                                  00000570
      ARGPB=DARSIN(SPINCA*SARGPA/SINCB)                                 00000580
C CALCULATE TOTAL ANGULAR PLANE ROTATION BETWEEN PARKING AND TRANSFER   00000590
C ORBITS.                                                               00000600
      ARGPAB=ANGL+ARGPB                                                 00000610
      PINCAB=(PINCA+INCB)/2.D0                                          00000620
      HANGL=(ANGL-ARGPB)/2.D0                                           00000630
      XISDE= DCOS(HANGL)/(DCOS(ARGPAB)*DTAN(PINCAB))                    00000640
      THETA1=2.D0*DATAN(XISDE)                                          00000650
C CALCULATE NODE ROTATION                                               00000660
      STHTA1=DSIN(THETA1)                                               00000670
      DELNOD=DARSIN(STHTA1*SARGPA/SINCB)                                00000680
C DETERMINE WHICH WAY TO ROTATE NODE AND FIND FINAL NODE.               00000690
      ROTA=NODEC-NODEA                                                  00000700
      IF(ROTA.LT.0.D0) ROTA=ROTA+PI2                                    00000710
      IF(ROTA.LT.PI) NODEB=NODEB+DELNOD                                 00000720
      IF(ROTA.GE.PI) NODEB=NODEB-DELNOD                                 00000730
      NODEB=DMOD(NODEB,PI2)                                             00000740
      IF(NODEB.LT.0.D0) NODEB=NODEB+PI2                                 00000750
      RETURN                                                            00000760
      END                                                               00000770
C          DATA SET NODROT     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE NODROT (JNOD, NODEA, NODEB, DNMAX)                     00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
      REAL*8 NODEA,NODEB                                                00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE NODROT (JNOD,NODEA,NODEB,DNMAX)                        00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF NODROT IS TO DETERMINE THE ASCENDING NODE OF THE   00000100
C         NEW ORBIT AFTER AN ORBIT-TO-ORBIT INSERTION MANEUVER.         00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          JNOD      I*4      I      OPTION FLAG---                     00000190
C                                       =1, INPUT NODE OF OLD ORBIT     00000200
C                                           (NODEA) AND THE NODE        00000210
C                                           ROTATION DESIRED            00000220
C                                           (-2*PI.LE.DNMAX.LE.2*PI),   00000230
C                                           AND COMPUTE NODE OF NEW     00000240
C                                           ORBIT (NODEB).              00000250
C                                       =2, INPUT NODE OF OLD ORBIT     00000260
C                                           (NODEA) AND DESIRED NODE FOR00000270
C                                           NEW ORBIT (NODEB). INPUT A  00000280
C                                           MAXIMUM ALLOWABLE NODE      00000290
C                                           ROTATION (0.LE.DNMAX.LE.PI).00000300
C                                           IF DABS(NODEB-NODEA).LE.    00000310
C                                           DNMAX, THE INPUT NODEB IS   00000320
C                                           RETAINED. OTHERWISE, NODEB  00000330
C                                           IS RE-COMPUTED.             00000340
C          NODEA     R*8      I      NODE OF OLD ORBIT (RADIANS)        00000350
C          NODEB     R*8     I/O     NODE OF NEW ORBIT (RADIANS)        00000360
C          DNMAX     R*8      I      NODE ROTATION (RADIANS)            00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     NODROT IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000410
C                                                                       00000420
C         MODE DRIVERS                                                  00000430
C                                                                       00000440
C                                                                       00000450
C                                                                       00000460
C     NO SUBROUTINES ARE CALLED BY NODROT.                              00000470
C                                                                       00000480
C                                                                       00000490
C                                                                       00000500
C     NODROT NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000510
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000520
C                                                                       00000530
C                                                                       00000540
C                                                                       00000550
      DATA PI,TWOPI /3.1415926535897932D0,6.2831853071795864D0/         00000560
      GO TO (10,2                                               ),JNOD  00000570
      WRITE (6,1001) JNOD                                               00000580
      STOP                                                              00000590
    2 DNAB = NODEB - NODEA                                              00000600
C     MAKE SURE -PI .LE. DNAB .LE. PI. (IF NOT, THEN THE SIGN ASSOCIATED00000610
C       BELOW WITH THE RE-CALCULATED DNAB IS CHOSEN SUCH THAT THE SUBSE-00000620
C       QUENT NODE ROTATION TAKES PLACE THROUGH THE SMALLER OF THE TWO  00000630
C       ANGLES BETWEEN A AND B.)                                        00000640
      IF (DNAB .GT. PI)  DNAB = -(TWOPI-DNAB)                           00000650
      IF (DNAB .LT. -PI) DNAB = +(TWOPI+DNAB)                           00000660
C IF DIFFERENCE BETWEEN INPUT NODES .GT. ALLOWED MAX., RE-CALCULATE NODE00000670
      IF ((DABS(DNAB) .GT. DNMAX) .AND. (DNAB .GT. 0.D0)) GO TO 10      00000680
      IF ((DABS(DNAB).GT.DNMAX).AND.(DNAB.LT.0.D0)) NODEB=NODEA-DNMAX   00000690
      GO TO 11                                                          00000700
   10 NODEB = NODEA + DNMAX                                             00000710
      IF (NODEB .GE. TWOPI) NODEB = NODEB-TWOPI                         00000720
   11 IF (NODEB .LT. 0.D0)  NODEB = NODEB+TWOPI                         00000730
      RETURN                                                            00000740
 1001 FORMAT (1H0, 'FATAL MESSAGE FROM NODROT. JNOD=',I3,', BUT ONLY VAL00000750
     2UES OF 1 OR 2 ARE MEANINGFUL. CHECK NAMELIST INPUT.')             00000760
      END                                                               00000770
C          DATA SET NODVEC     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE NODVEC (HX,HY,O)                                       00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE NODVEC (HX,HY,O)                                       00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF NODVEC IS TO CALCULATE THE ASCENDING NODE UNIT     00000090
C         VECTOR OF AN ORBIT FROM THE X AND Y COMPONENTS OF ITS ANGULAR 00000100
C         MOMENTUM UNIT VECTOR.                                         00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          HX,HY     R*8      I      X AND Y COMPONENTS, ANGULAR        00000190
C                                       MOMENTUM UNIT VECTOR            00000200
C          O(3)      R*8      O      ASCENDING NODE UNIT VECTOR         00000210
C                                                                       00000220
C                                                                       00000230
C                                                                       00000240
C     NODVEC IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000250
C                                                                       00000260
C         INSERT                                                        00000270
C                                                                       00000280
C                                                                       00000290
C                                                                       00000300
C     NO SUBROUTINES ARE CALLED BY NODVEC.                              00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     NODVEC NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000350
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
      DIMENSION O(3)                                                    00000400
      OMAG = DSQRT(HY*HY+HX*HX)                                         00000410
      O(1) = -HY/OMAG                                                   00000420
      O(2) = HX/OMAG                                                    00000430
      O(3) = 0.D0                                                       00000440
      RETURN                                                            00000450
      END                                                               00000460
C          DATA SET OFSHOR     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE OFSHOR (A,E,INC,NODE,ARGP,AMEAN,PERIOD,ARC,SOL,        00000010
     2                   JPEN,JUMB,PEN,UMB)                             00000020
      IMPLICIT REAL*8(A-H,O-Z)                                          00000030
C                                                                       00000040
C     OFSHOR STANDS FOR OPTION FOR SHADOW IN ORBIT.                     00000050
C                                                                       00000060
C     SUBROUTINE OFSHOR (A,E,INC,NODE,ARGP,AMEAN,PERIOD,ARC,SOL,JPEN,   00000070
C                        JUMB,PEN,UMB)                                  00000080
C                                                                       00000090
C                                                                       00000100
C                                                                       00000110
C     THE PURPOSE OF OFSHOR IS TO COMPUTE SHADOW INCIDENCES AND         00000120
C         DURATIONS ALONG ORBITAL SEGMENTS.                             00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          A         R*8      I      ORBITAL SEMI-MAJOR AXIS (KM)       00000210
C          E         R*8      I      ORBITAL ECCENTRICITY               00000220
C          INC       R*8      I      ORBITAL INCLINATION (RADIANS)      00000230
C          NODE      R*8      I      RIGHT ASCENSION OF THE ASCENDING   00000240
C                                       NODE (RADIANS)                  00000250
C          ARGP      R*8      I      ARGUMENT OF PERIGEE (RADIANS)      00000260
C          AMEAN     R*8      I      MEAN ANOMALY THAT MARKS THE        00000270
C                                       BEGINNING OF THE ARC FOR WHICH  00000280
C                                       SHADOW ANALYSIS IS DESIRED      00000290
C                                       (RADIANS)                       00000300
C          PERIOD    R*8      I      ORBITAL PERIOD (MINUTES)           00000310
C          ARC       R*8      I      TIME REQUIRED TO TRAVERSE ORBITAL  00000320
C                                       SEGMENT FOR WHICH SHADOW        00000330
C                                       ANALYSIS IS DESIRED (MINUTES)   00000340
C          SOL(3)    R*8      I      EARTH-TO-SUN POSITION VECTOR (KM)  00000350
C          JPEN,JUMB I*4     I/O     SHADOW INPUT FLAGS --              00000360
C                                       .NE.0, DO PENUMBRAL, UMBRAL     00000370
C                                              CALCULATIONS             00000380
C                                       .EQ.0, DO NOT DO THE            00000390
C                                              CALCULATIONS             00000400
C                                    SHADOW OUTPUT FLAGS --             00000410
C                                       .NE.4, NO SOLUTIONS FOUND       00000420
C                                       .EQ.4, SOLUTIONS FOUND          00000430
C          PEN(5)    R*8      O      PENUMBRAL SHADOW INCIDENCES AND    00000440
C                                       DURATIONS --                    00000450
C           (1)                         FIRST INCIDENCE OF SHADOW       00000460
C                                          ALONG ARC                    00000470
C                                          (MINUTES FROM AMEAN)         00000480
C           (2)                         DURATION OF FIRST SHADOW ALONG  00000490
C                                          ARC (MINUTES)                00000500
C           (3)                         SECOND INCIDENCE OF SHADOW      00000510
C                                          ALONG ARC                    00000520
C                                          (MINUTES FROM AMEAN)         00000530
C           (4)                         DURATION OF SECOND SHADOW ALONG 00000540
C                                          ARC (MINUTES)                00000550
C           (5)                         TOTAL SHADOW DURATION (FIRST    00000560
C                                          PLUS SECOND) ALONG ARC       00000570
C                                          (MINUTES)                    00000580
C          UMB(5)    R*8      O      UMBRAL SHADOW INCIDENCES AND       00000590
C                                       DURATIONS (SAME AS PEN, BUT FOR 00000600
C                                       UMBRA)                          00000610
C                                                                       00000620
C                                                                       00000630
C                                                                       00000640
C     OFSHOR IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000650
C                                                                       00000660
C         LAUCON                                                        00000670
C                                                                       00000680
C                                                                       00000690
C                                                                       00000700
C     THE FOLLOWING SUBROUTINES ARE CALLED BY OFSHOR.                   00000710
C                                                                       00000720
C         MEANOM    SHALE     SHORB2                                    00000730
C                                                                       00000740
C                                                                       00000750
C                                                                       00000760
C     OFSHOR NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000770
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000780
C                                                                       00000790
C                                                                       00000800
C                                                                       00000810
      REAL*8 INC,NODE                                                   00000820
      DIMENSION SOL(3),F(4),EANOM(4),XM(4),T(4),ELM(6),PEN(5),UMB(5)    00000830
      DATA REARTH,RSUN,PI/6378.140D0,695500.0D0,3.1415926535897932D0/   00000840
      KPSHAD=1                                                          00000850
      KUSHAD=1                                                          00000860
      RECTUM = A*(1.D0 - E * E)                                         00000870
C*****CALCULATE TRUE ANOMALIES FOR SHADOW                               00000880
C     ENTRANCES AND EXITS ALONG ONE FULL REVOLUTION.                    00000890
      ELM(1)= RECTUM                                                    00000900
      ELM(2)= E                                                         00000910
      ELM(3) = 0.D0                                                     00000920
      ELM(4)= ARGP                                                      00000930
      ELM(5)= INC                                                       00000940
      ELM(6)= NODE                                                      00000950
      CALL SHORB2 (ELM,SOL,REARTH,RSUN,JUMB,JPEN,F(2),F(3),F(1),F(4))   00000960
C*****CONVERT TO MEAN ANOMALIES.                                        00000970
      DO 25 K = 1,4                                                     00000980
   25 CALL MEANOM(E,F(K),EANOM(K),XM(K))                                00000990
C                                                                       00001000
C*****SHORB2 SOMETIMES REVERSES ENTERING AND EXITING ANGLES. CHECK FOR  00001010
C         THIS PROBLEM AND CORRECT IT WHEN NECESSARY.                   00001020
      IF ((XM(4)-XM(1)) .GT. PI) GO TO 100                              00001030
      IF (((XM(4)-XM(1)) .LT. 0.D0) .AND. ((XM(4)-XM(1)) .GT. -PI))     00001040
     2  GO TO 100                                                       00001050
      GO TO 200                                                         00001060
  100 XM4=XM(4)                                                         00001070
      XM(4)=XM(1)                                                       00001080
      XM(1)=XM4                                                         00001090
  200 IF ((XM(3)-XM(2)) .GT. PI) GO TO 300                              00001100
      IF (((XM(3)-XM(2)) .LT. 0.D0) .AND. ((XM(3)-XM(2)) .GT. -PI))     00001110
     2  GO TO 300                                                       00001120
      GO TO 400                                                         00001130
  300 XM3=XM(3)                                                         00001140
      XM(3)=XM(2)                                                       00001150
      XM(2)=XM3                                                         00001160
  400 CONTINUE                                                          00001170
C                                                                       00001180
C*****COMPARE WITH MEAN ANOMALY OF INSERTION POINT IN ORDER TO SET UP   00001190
C     TIMES TO BE PASSED TO SHALE.                                      00001200
      DO 50 K = 1,4                                                     00001210
      T(K) = PERIOD * (XM(K)-AMEAN) / (2.D0*PI)                         00001220
      IF (T(K) .LT. 0.D0) T(K) = T(K) + PERIOD                          00001230
   50 CONTINUE                                                          00001240
C*****SUBROUTINE SHALE COMPUTES SHADOW INCIDENCES AND DURATIONS.        00001250
      IF (JUMB .NE. 4) KUSHAD=0                                         00001260
      CALL SHALE(KUSHAD,T(2),T(3),ARC,UMB(1),UMB(3),UMB(2),UMB(4))      00001270
      UMB(5) = UMB(2) + UMB(4)                                          00001280
      IF (JPEN .NE. 4) KPSHAD=0                                         00001290
      CALL SHALE(KPSHAD,T(1),T(4),ARC,PEN(1),PEN(3),PEN(2),PEN(4))      00001300
      PEN(5) = PEN(2) + PEN(4)                                          00001310
      RETURN                                                            00001320
      END                                                               00001330
C          DATA SET OUTELM     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE OUTELM (MORB,JORBIT,A,E,XI,XN,AOP,TRUE)                00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE OUTELM (MORB,JORBIT,A,E,XI,XN,AOP,TRUE)                00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF OUTELM IS TO PRINT THE KEPLERIAN ELEMENTS OF AN    00000090
C         ORBIT INTO THE ORBITAL INFORMATION SUMMARY TABLE.             00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          MORB      I*4      I      PRINTER UNIT OF ORBITAL INFORMATION00000180
C                                       SUMMARY TABLE                   00000190
C          JORBIT    I*4      I      NUMBER SIGNIFYING THE ORBIT OF THE 00000200
C                                       MISSION SEQUENCE                00000210
C          A         R*8      I      SEMI-MAJOR AXIS (KM)               00000220
C          E         R*8      I      ECCENTRICITY                       00000230
C          XI        R*8      I      INCLINATION (DEGREES)              00000240
C          XN        R*8      I      RIGHT ASCENSION OF THE ASCENDING   00000250
C                                       NODE (DEGREES)                  00000260
C          AOP       R*8      I      ARGUMENT OF PERIAPSIS (DEGREES)    00000270
C          TRUE      R*8      I      TRUE ANOMALY (DEGREES)             00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     OUTELM IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000320
C                                                                       00000330
C         MODE DRIVERS                                                  00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     NO SUBROUTINES ARE CALLED BY OUTELM.                              00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
C     OUTELM NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000420
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000430
C                                                                       00000440
C                                                                       00000450
C                                                                       00000460
      WRITE (MORB,1003) JORBIT,A,E,XI,XN,AOP,TRUE                       00000470
      RETURN                                                            00000480
 1003 FORMAT (1H , '      ****ORBIT ', I2, ' KEPLERIAN ELEMENTS -- '/'  00000490
     2         SEMI-MAJOR AXIS . . . . . . . . . . . . . . . . . . . . .00000500
     3 . . . . . . A     =', D18.10, '  KM.' /'           ECCENTRICITY. 00000510
     4. . . . . . . . . . . . . . . . . . . . . . . . . . . . E     =', 00000520
     5  D18.10/'           INCLINATION . . . . . . . . . . . . . . . . .00000530
     6 . . . . . . . . . . . . I     =',D18.10,'  DEGREES.'/'           00000540
     7RIGHT ASCENSION OF ASCENDING NODE . . . . . . . . . . . . . . . . 00000550
     8. . NOD   =', D18.10, '  DEGREES.'/'           ARGUMENT OF PERIGEE00000560
     9 . . . . . . . . . . . . . . . . . . . . . . . . . AOP   =',      00000570
     A D18.10,'  DEGREES.'/'           TRUE ANOMALY OF INSERTION POINT .00000580
     B . . . . . . . . . . . . . . . . . . TRUE  =',D18.10,'  DEGREES.')00000590
      END                                                               00000600
C          DATA SET OUTFLO     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE OUTFLO (H,N)                                           00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE OUTFLO (H,N)                                           00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF OUTFLO IS TO SET UP PRINTER OUTPUT. OUTFLO MATCHES 00000090
C         COLUMN HEADINGS WITH THE OUTPUT VARIABLES CHOSEN BY THE USER, 00000100
C         CALLS THE ROUTINE (DEFINE) WHICH PRINTS DEFINITIONS FOR THE   00000110
C         OUTPUT VARIABLES, AND SETS UP AN ARRAY WHICH FLAGS THE DESIRED00000120
C         OUTPUT VARIABLES FOR THE PRINTOUT ROUTINE (SPILL).            00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          H(2,N)    R*8      I      ARRAY CONTAINING COLUMN HEADINGS   00000210
C                                       AND CODE NUMBERS OF ALL N       00000220
C                                       POSSIBLE OUTPUT PARAMETERS      00000230
C          N         I*4      I      TOTAL NUMBER OF OUTPUT PARAMETERS  00000240
C                                       FROM WHICH USER CAN CHOOSE      00000250
C                                       (DEPENDS ON MODE)               00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     OUTFLO IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000300
C                                                                       00000310
C         TITLE ROUTINES                                                00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     THE FOLLOWING SUBROUTINE IS CALLED BY OUTFLO.                     00000360
C                                                                       00000370
C         DEFINE                                                        00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000420
C                                                                       00000430
C         COMMON VARIABLES USED                                         00000440
C                                                                       00000450
C         M(7)      OUT(11,7)                                           00000460
C                                                                       00000470
C         COMMON VARIABLES COMPUTED                                     00000480
C                                                                       00000490
C         C(11,7)   IP(11,7)  JCOUNT(7)                                 00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000540
      COMMON/SP3/C(11,7),IP(11,7),JCOUNT(7)                             00000550
      DIMENSION H(2,N)                                                  00000560
      DO 2 JJ = 1,7                                                     00000570
    2 JCOUNT(JJ) = 0                                                    00000580
C     TITLES FOR UNIT M(JJ).                                            00000590
      DO 20 JJ = 1,7                                                    00000600
C     SKIP UNITS NOT BEING USED.                                        00000610
      IF (M(JJ) .EQ. 0) GO TO 21                                        00000620
      MU = M(JJ)                                                        00000630
      WRITE (MU,1000) MU                                                00000640
C     THERE ARE 11 COLUMNS OF OUTPUT DATA PER UNIT.                     00000650
      DO 15 J = 1,11                                                    00000660
C     A ZERO IN THE OUT ARRAY CAUSES ALL REMAINING DATA COLUMNS ON THIS 00000670
C          UNIT TO BE SKIPPED.                                          00000680
      IF (OUT(J,JJ) .EQ. 0.D0) GO TO 20                                 00000690
      JCOUNT(JJ) = JCOUNT(JJ) + 1                                       00000700
C     FIND THE TITLE CORRESPONDING TO THE USER-CHOSEN CODE NUMBER.      00000710
      K =  OUT(J,JJ) - H(2,1) + 1.0001D0                                00000720
      IF (K .GT. N)  GO TO 5                                            00000730
      C(JCOUNT(JJ),JJ)  =  H(1,K)                                       00000740
      KODE  =  H(2,K)                                                   00000750
      WRITE (MU,1001)                                                   00000760
      CALL DEFINE (MU,KODE)                                             00000770
      IP(JCOUNT(JJ),JJ)  = K                                            00000780
      GO TO 15                                                          00000790
C     IF AN INVALID CODE NUMBER IS DETECTED, IT IS SIMPLY SKIPPED.      00000800
    5 JCOUNT(JJ)  = JCOUNT(JJ) - 1                                      00000810
   15 CONTINUE                                                          00000820
   20 CONTINUE                                                          00000830
   21 RETURN                                                            00000840
 1000 FORMAT (1H1,35X,'*****  DEFINITIONS OF VARIABLES PRINTED ON UNIT',00000850
     2   I3,'  *****'/' ',51X,'(FROM SUBROUTINE ''DEFINE'')'/)          00000860
 1001 FORMAT (1H0)                                                      00000870
      END                                                               00000880
C          DATA SET OUTHED     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN1,NODE)          00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE OUTHED (MORB,JSCAN,DATE,GMTL,TLINJ,TIN1,NODE)          00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF OUTHED IS TO PRINT HEADINGS AND THE STARTING VALUES00000090
C         USED IN LAUNCH DATE, LAUNCH TIME, AND NODE SCANS INTO THE     00000100
C         ORBITAL INFORMATION SUMMARY TABLE.                            00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          MORB      I*4      I      PRINTER UNIT OF ORBITAL INFORMATION00000190
C                                       SUMMARY TABLE                   00000200
C          JSCAN     I*4      I      SCAN OPTION FLAG                   00000210
C                                       =1, NODE SCAN                   00000220
C                                       =2, LAUCH TIME SCAN             00000230
C          DATE      R*8      I      FIRST  DATE IN DATE SCAN (YYMM.DD) 00000240
C          GMTL      R*8      I      INITIAL VALUE FOR GREENWICH MEAN   00000250
C                                       TIME OF LAUNCH, IN HOURS (MAY BE00000260
C                                       GREATER THAN 24)                00000270
C          TLINJ     R*8      I      TIME BETWEEN LAUNCH AND ORBITAL    00000280
C                                       INJECTION (SECONDS)             00000290
C          TIN1      R*8      I      INITIAL VALUE FOR ORBITAL INJECTION00000300
C                                       TIME (HOURS)                    00000310
C          NODE      R*8      I      INITIAL VALUE FOR RIGHT ASCENSION  00000320
C                                       OF ASCENDING NODE OF ORBIT      00000330
C                                       (RADIANS)                       00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     OUTHED IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000380
C                                                                       00000390
C         MODE DRIVERS                                                  00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C     NO SUBROUTINES ARE CALLED BY OUTHED.                              00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     OUTHED NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000480
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
      REAL*8 NODE,NODEG                                                 00000540
      NODEG = NODE/0.017453292519943D0                                  00000550
      WRITE (MORB,1001) DATE,GMTL,TLINJ,TIN1,NODEG,JSCAN                00000560
      WRITE (MORB,1002)                                                 00000570
      RETURN                                                            00000580
 1001 FORMAT (1H1,'STARTING VALUES FOR SCAN PARAMETERS ARE'/' DATE=',   00000590
     2        F8.2,4X,'GMTL=',D12.5,' HRS',4X,'TLINJ=',D12.5,' SECS',   00000600
     3        4X,'T1N1=',D12.5,' HRS',4X,'NOD1=',D12.5,' DEG', 4X,      00000610
     4        'JSCAN=',I2///)                                           00000620
 1002 FORMAT (1H ,'*****************************************************00000630
     2****ORBIT INFORMATION*********************************************00000640
     3*********'//' IF JSCAN=1 (NODE SCAN), THE QUANTITIES IN THIS TABLE00000650
     4 DO NOT VARY OVER DATE FOR A GIVEN NODE VALUE.'/' IF JSCAN=2 (TIME00000660
     5 SCAN) THE FOLLOWING QUANTITIES VARY OVER DATE FOR A GIVEN TIME VA00000670
     6LUE--'/'            (1)EACH ORBIT''S NODE.   (2)ALL VELOCITY VECTO00000680
     7RS (X AND Y COMPONENTS) AT INSERTION POINTS.   (3)RIGHT ASCENSIONS00000690
     8.'/' FURTHERMORE, IF JSCAN=2 AND JNOD=2 FOR ONE OF THE ORBITS, THE00000700
     9N ALL QUANTITIES BELOW WHICH PERTAIN TO THAT ORBIT MAY VARY OVER D00000710
     AATE.'/' IN CASES WHERE QUANTITIES MAY VARY, THOSE TABULATED BELOW 00000720
     BARE FOR THE FIRST DATE IN A SCAN. THAT DATE IS GIVEN ABOVE.'//)   00000730
      END                                                               00000740
C          DATA SET OUTSET     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE OUTSET (MORB,JA,JB,JAPSIS,SB)                          00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE OUTSET (MORB,JA,JB,JAPSIS,SB)                          00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF OUTSET IS TO PRINT ORBITAL INSERTION AND MANEUVER  00000090
C         INFORMATION INTO THE ORBITAL INFORMATION SUMMARY TABLE.       00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          MORB      I*4      I      PRINTER UNIT FOR ORBITAL           00000180
C                                       INFORMATION SUMMARY TABLE       00000190
C          JA,JB     I*4      I      INTEGERS SIGNIFYING WHICH ORBITS OF00000200
C                                       THE MISSION SEQUENCE ARE        00000210
C                                       INVOLVED IN THIS MANEUVER (E.G.,00000220
C                                       JA=2 AND JB=3 SIGNIFIES         00000230
C                                       INSERTION FROM ORBIT 2 TO       00000240
C                                       ORBIT 3)                        00000250
C          JAPSIS    I*4      I      FLAG INDICATING IF INSERTION POINT 00000260
C                                       IS PERIGEE (-1) OR APOGEE (+1)  00000270
C                                       OF ORBIT JB, OR IF JB IS A      00000280
C                                       CIRCLE (0)                      00000290
C          SB(30)    R*8      I      30 OUTPUTS FROM INSERT ROUTINE, OF 00000300
C                                       WHICH THE FOLLOWING 15 ARE      00000310
C                                       PRINTED --                      00000320
C           (2)                         MAGNITUDE OF INSERTION POSITION 00000330
C                                          VECTOR (KM)                  00000340
C           (3)                         TRUE ANOMALY IN OLD ORBIT AT    00000350
C                                          WHICH INSERTION TO NEW ORBIT 00000360
C                                          OCCURS (DEGREES)             00000370
C           (4)                         TIME SPENT IN OLD ORBIT, NOT    00000380
C                                          INCLUDING EXTRA REVOLUTIONS  00000390
C                                          (MINUTES)                    00000400
C          (5-10)                       VELOCITY VECTORS IMMEDIATELY    00000410
C                                          BEFORE AND AFTER INSERTION   00000420
C                                          MANEUVER (KM/SEC)            00000430
C         (11-13)                       MANEUVER VELOCITY VECTOR        00000440
C                                          (KM/SEC)                     00000450
C           (14)                        MAGNITUDE OF MANEUVER VELOCITY  00000460
C                                          VECTOR (KM/SEC)              00000470
C         (15-16)                       RIGHT ASCENSION AND DECLINATION 00000480
C                                          OF MANEUVER VELOCITY VECTOR  00000490
C                                          (DEGREES)                    00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
C     OUTSET IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000540
C                                                                       00000550
C         MODE DRIVERS                                                  00000560
C                                                                       00000570
C                                                                       00000580
C                                                                       00000590
C     NO SUBROUTINES ARE CALLED BY OUTSET.                              00000600
C                                                                       00000610
C                                                                       00000620
C                                                                       00000630
C     OUTSET NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000640
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000650
C                                                                       00000660
C                                                                       00000670
C                                                                       00000680
      DIMENSION SB(30)                                                  00000690
      IF (MORB .EQ. 0) RETURN                                           00000700
C*****WRITE OUT DATA ON UNIT MORB.                                      00000710
      WRITE (MORB,1000) JA,JB                                           00000720
      IF (JAPSIS) 5,10,15                                               00000730
    5 WRITE (MORB,1001)                                                 00000740
      GO TO 20                                                          00000750
   10 WRITE (MORB,1002)                                                 00000760
      GO TO 20                                                          00000770
   15 WRITE (MORB,1003)                                                 00000780
   20 WRITE (MORB,1004) SB(2)                                           00000790
      WRITE (MORB,1005) SB(5), SB(6), SB(7)                             00000800
      WRITE (MORB,1006) SB(8), SB(9), SB(10)                            00000810
      WRITE (MORB,1007) SB(11),SB(12),SB(13)                            00000820
      WRITE (MORB,1008) SB(14)                                          00000830
      WRITE (MORB,1009) SB(15)                                          00000840
      WRITE (MORB,1010) SB(16)                                          00000850
      WRITE (MORB,1011) SB(3)                                           00000860
      WRITE (MORB,1012) SB(4)                                           00000870
      RETURN                                                            00000880
 1000 FORMAT(1H0,'******  ORBIT',I3,' TO ORBIT',I3,' INSERTION. ******')00000890
 1001 FORMAT (1H ,'          INSERTION POINT IS PERIGEE OF NEW ORBIT.') 00000900
 1002 FORMAT (1H ,'          NEW ORBIT IS A CIRCLE.')                   00000910
 1003 FORMAT (1H ,'          INSERTION POINT IS APOGEE OF NEW ORBIT.')  00000920
 1004 FORMAT (1H ,'          MAGNITUDE OF INSERTION POSITION VECTOR. . .00000930
     2. . . . . . . . .  . . . . RINS  =',D18.10, '  KM.')              00000940
 1005 FORMAT (1H , '          VELOCITY VECTOR COMPONENTS IMMEDIATELY BEF00000950
     2ORE INSERTION . . . . . . . VA(1) =', D18.10, '  KM/SEC.'/'       00000960
     3                                                            . . . 00000970
     4. . . . VA(2) =', D18.10, '  KM/SEC.'/'                           00000980
     5                                        . . . . . . . VA(3) =',   00000990
     6    D18.10, '  KM/SEC.')                                          00001000
 1006 FORMAT (1H , '          VELOCITY VECTOR COMPONENTS IMMEDIATELY  AF00001010
     2TER INSERTION . . . . . . . VB(1) =', D18.10, '  KM/SEC.'/'       00001020
     3                                                            . . . 00001030
     4. . . . VB(2) =', D18.10, '  KM/SEC.'/'                           00001040
     5                                        . . . . . . . VB(3) =',   00001050
     6    D18.10, '  KM/SEC.')                                          00001060
 1007 FORMAT (1H , '          MANEUVER VELOCITY VECTOR COMPONENTS . . . 00001070
     2. . . . . . . . . . . . . . DELV(1)=',D17.10, '  KM/SEC.'/'       00001080
     3                                                            . . . 00001090
     4. . . . DELV(2)=',D17.10, '  KM/SEC.'/'                           00001100
     5                                        . . . . . . . DELV(3)=',  00001110
     6    D17.10, '  KM/SEC.')                                          00001120
 1008 FORMAT (1H , '          MAGNITUDE OF MANEUVER VELOCITY VECTOR . . 00001130
     2. . . . . . . . . . . . . . DV    =',D18.10, '  KM/SEC.' )        00001140
 1009 FORMAT (1H , '          RIGHT ASCENSION, MANEUVER VELOCITY VECTOR 00001150
     2. . . . . . . . . . . . . . RA    =',D18.10, '  DEGREES.')        00001160
 1010 FORMAT (1H , '          DECLINATION, MANEUVER VELOCITY VECTOR . . 00001170
     2. . . . . . . . . . . . . . DECL  =', D18.10, '  DEGREES.')       00001180
 1011 FORMAT (1H , '          TRUE ANOMALY IN OLD ORBIT AT WHICH INSERTI00001190
     2ON TO NEW ORBIT OCCURS. . . TA    =',D18.10, '  DEGREES.')        00001200
 1012 FORMAT (1H , '          REAL TIME SPENT IN OLD ORBIT. . . . . . . 00001210
     2. . . . . . . . . . . . . . STAY  =',D18.10, '  MINUTES.' )       00001220
      END                                                               00001230
C          DATA SET PCONIK     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE PCONIK(MB,TW,TF,R,V)                                   00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE PCONIK (MB,TW,TF,R,V)                                  00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF PCONIK IS TO DETERMINE THE CARTESIAN POSITION AND  00000090
C         VELOCITY OF ANY PLANET WITH RESPECT TO THE SUN, OR OF THE MOON00000100
C         WITH RESPECT TO THE EARTH.                                    00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          MB        I*4      I      BODY NUMBER--                      00000190
C                                       1. MERCURY                      00000200
C                                       2. VENUS                        00000210
C                                       3. EARTH                        00000220
C                                       4. MARS                         00000230
C                                       5. JUPITER                      00000240
C                                       6. SATURN                       00000250
C                                       7. URANUS                       00000260
C                                       8. NEPTUNE                      00000270
C                                       9. PLUTO                        00000280
C                                      10. SUN                          00000290
C                                      11. MOON                         00000300
C                                      12. EXTRA BODY                   00000310
C          TW        R*8      I      DATE--WHOLE DAYS FROM 1950.0       00000320
C          TF        R*8      I      DATE--FRACTIONAL DAYS FROM 1950.0  00000330
C          R(3)      R*8      O      CARTESIAN POSITION OF MB, MEAN     00000340
C                                       EQUATOR AND EQUINOX OF DATE (KM)00000350
C          V(3)      R*8      O      CARTESIAN VELOCITY OF MB, MEAN     00000360
C                                       EQUATOR AND EQUINOX OF DATE     00000370
C                                       (KM/SEC)                        00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
C     PCONIK IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000420
C                                                                       00000430
C         SUNEPH                                                        00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C     THE FOLLOWING SUBROUTINE IS CALLED BY PCONIK.                     00000480
C                                                                       00000490
C         APEFEM                                                        00000500
C                                                                       00000510
C                                                                       00000520
C                                                                       00000530
C     PCONIK NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000540
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000550
C                                                                       00000560
C                                                                       00000570
C                                                                       00000580
      DIMENSION R(3),V(3)                                               00000590
      IAP = 1                                                           00000600
      DATA AU,AUV/.149599D9,.047405062D0/                               00000610
      DATA SPMSD/86400.D0/                                              00000620
      TDO = (TW + TF)*SPMSD                                             00000630
      CALL APEFEM(TDO,MB,R,V,IAP)                                       00000640
      DO 10 I=1,3                                                       00000650
      R(I) = AU*R(I)                                                    00000660
      V(I) = AUV*V(I)                                                   00000670
   10 CONTINUE                                                          00000680
      RETURN                                                            00000690
      END                                                               00000700
      SUBROUTINE QUARTC(C,X,N)                                          00000100
      IMPLICIT REAL*8(A-H,O-Z)                                          00000200
C                                                                       00000300
C                                                                       00000400
C     SUBROUTINE QUARTC (C,X,N)                                         00000500
C                                                                       00000600
C                                                                       00000700
C                                                                       00000800
C     THE PURPOSE OF QUARTC IS TO FIND THE REAL ROOTS OF A CUBIC OR     00000900
C        QUARTIC EQUATION--THAT IS,  AN EQUATION OF THE FORM:           00001000
C                                                                       00001100
C          C(1) + C(2)*X + C(3)*X**2 + C(4)*X**3 + C(5)*X**4 = 0        00001200
C                                                                       00001300
C                                                                       00001400
C                                                                       00001500
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:         00001600
C                                                                       00001700
C          ARGUMENT    TYPE    I/O     DEFINITION                       00001800
C                                                                       00001900
C          C(5)        R*8      I      COEFFICIENTS OF THE POLYNOMIAL   00002000
C          X(4)        R*8      O      REAL SOLUTIONS (UPPER-LOADED     00002100
C                                      IF LESS THAN 4 EXIST)            00002200
C          N           I*4      I/O    INPUT AS THE ORDER OF THE        00002300
C                                      POLYNOMIAL (3 OR 4)              00002400
C                                      OUTPUT AS NUMBER OF REAL         00002500
C                                      SOLUTIONS FOUND (0,1,2,3, OR 4)  00002600
C                                                                       00002700
C                                                                       00002800
C                                                                       00002900
C     QUARTC IS CALLED BY THE FOLLOWING SUBROUTINE:                     00003000
C                                                                       00003100
C          SHORB2                                                       00003200
C                                                                       00003300
C                                                                       00003400
C                                                                       00003500
C     NO SUBROUTINES ARE CALLED BY QUARTC                               00003600
C                                                                       00003700
C                                                                       00003800
C                                                                       00003900
C     QUARTC NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00004000
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00004100
C                                                                       00004200
C                                                                       00004300
C                                                                       00004400
      DIMENSION C(5),X(4),AI(4)                                         00004500
      EQUIVALENCE (AI(1),R), (AI(2),Q), (AI(3),P)                       00004600
      DATA S3/1.7320508D0/                                              00004700
      DO 1 I=1,N                                                        00004800
    1 AI(I)=C(I)/C(N+1)                                                 00004900
      GO TO (80,80,3,2),N                                               00005000
    2 CONTINUE                                                          00005100
      H=-AI(4)/4.D0                                                     00005200
      U=H*(6.D0*H+3.D0*AI(4))+AI(3)                                     00005300
      V=H*(H*(4.D0*H+3.D0*AI(4))+2.D0*AI(3))+AI(2)                      00005400
      W=H*(H*(H*(H+AI(4))+AI(3))+AI(2))+AI(1)                           00005500
      P=2.D0*U                                                          00005600
      Q=U**2-4.D0*W                                                     00005700
      R=-V**2                                                           00005800
    3 CONTINUE                                                          00005900
      P2=P*P                                                            00006000
      A=(3.D0*Q-P2)/3.D0                                                00006100
      B=P*(2.D0*P2-9.D0*Q)/27.D0+R                                      00006200
      S=-P/3.D0                                                         00006300
      A327=A*A*A/27.D0                                                  00006400
      BO2=B/2.D0                                                        00006500
      DEL=A327+BO2*BO2                                                  00006600
      IF (DEL) 10,20,30                                                 00006700
   10 CONTINUE                                                          00006800
      EO=2.D0*DSQRT(-A/3.D0)                                            00006900
      CO=-BO2/DSQRT(-A327)                                              00007000
      SO=DSQRT(1.D0-CO*CO)                                              00007100
      O=DATAN2(SO,CO)                                                   00007200
      OO3=O/3.D0                                                        00007300
      COO3=DCOS(OO3)                                                    00007400
      SOO3=DSIN(OO3)                                                    00007500
      Z1=EO*COO3                                                        00007600
      Z2=-EO*(COO3+S3*SOO3)/2.D0                                        00007700
      Z3=-EO*(COO3-S3*SOO3)/2.D0                                        00007800
      NS=3                                                              00007900
      GO TO 40                                                          00008000
   20 CONTINUE                                                          00008100
      IF(BO2.LT.0.D0) GO TO 30                                          00008200
      Z1=BO2**(1.D0/3.D0)                                               00008300
      GO TO 31                                                          00008400
   30 CONTINUE                                                          00008500
      SRD=DSQRT(DEL)                                                    00008600
      CURT=1.D0/3.D0                                                    00008700
      FAC1=-BO2+SRD                                                     00008800
      FAC2=-BO2-SRD                                                     00008900
      Z1=DSIGN(DABS(FAC1)**CURT,FAC1)+DSIGN(DABS(FAC2)**CURT,FAC2)      00009000
   31 Z2=Z1-1.D0                                                        00009100
      Z3=Z2                                                             00009200
      NS=1                                                              00009300
   40 CONTINUE                                                          00009400
      Z1=Z1+S                                                           00009500
      Z2=Z2+S                                                           00009600
      Z3=Z3+S                                                           00009700
      GO TO (80,80,44,45),N                                             00009800
   44 CONTINUE                                                          00009900
      X(1)=Z1                                                           00010000
      X(2)=Z2                                                           00010100
      X(3)=Z3                                                           00010200
      GO TO 80                                                          00010300
   45 CONTINUE                                                          00010400
      NS=0                                                              00010500
      RP=DMAX1(Z1,Z2,Z3)                                                00010600
      SR=DSQRT(RP)                                                      00010700
      SRO2=SR/2.D0                                                      00010800
      PPRP=(U+RP)/2.D0                                                  00010900
      QOSR=V/SR/2.D0                                                    00011000
      XI=PPRP-QOSR                                                      00011100
      BETA=PPRP+QOSR                                                    00011200
      DISC=RP-4.D0*XI                                                   00011300
      IF(DISC) 60,50,50                                                 00011400
   50 CONTINUE                                                          00011500
      DISC=DSQRT(DISC)/2.D0                                             00011600
      X(1)=-SRO2+DISC+H                                                 00011700
      X(2)=-SRO2-DISC+H                                                 00011800
      NS=2                                                              00011900
   60 CONTINUE                                                          00012000
      DISC=RP-4.D0*BETA                                                 00012100
      IF(DISC) 80,70,70                                                 00012200
   70 CONTINUE                                                          00012300
      DISC=DSQRT(DISC)/2.D0                                             00012400
      X(NS+1)=SRO2+DISC+H                                               00012500
      NS=NS+2                                                           00012600
      X(NS)=SRO2-DISC+H                                                 00012700
   80 CONTINUE                                                          00012800
      N=NS                                                              00012900
      RETURN                                                            00013000
      END                                                               00013100
C          DATA SET RECEL      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE RECEL(U,R,V,TFP,ELEM,XM)                               00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
      DIMENSION R(3),V(3),WW(3),XL(3)                                   00000030
      DIMENSION ELEM(6),XNU(2),XNUP(3)                                  00000040
      DATA RAD/57.29577951308232D0/                                     00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     SUBROUTINE RECEL (U,R,V,TFP,ELEM,XM)                              00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     THE PURPOSE OF RECEL IS TO TRANSFORM THE CARTESIAN COORDINATES OF 00000140
C         A VEHICLE IN ORBIT INTO KEPLERIAN ELEMENTS FOR CIRCULAR,      00000150
C         ELLIPTIC, AND HYPERBOLIC ORBITS.                              00000160
C                                                                       00000170
C                                                                       00000180
C                                                                       00000190
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000200
C                                                                       00000210
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000220
C                                                                       00000230
C          U         R*8      I      GRAVITATIONAL CONSTANT             00000240
C          R(3)      R*8      I      POSITION VECTOR                    00000250
C          V(3)      R*8      I      VELOCITY VECTOR                    00000260
C          TFP       R*8      O      TIME FROM PERIAPSIS                00000270
C          ELEM(6)   R*8      O      KEPLERIAN ELEMENTS --              00000280
C           (1)                         SEMIMAJAR AXIS                  00000290
C           (2)                         ECCENTRICITY                    00000300
C           (3)                         INCLINATION (DEGREES)           00000310
C           (4)                         RIGHT ASCENSION OF ASCENDING    00000320
C                                          NODE (DEGREES)               00000330
C           (5)                         ARGUMENT OF PERIAPSIS (DEGREES) 00000340
C           (6)                         TRUE ANOMALY (DEGREES)          00000350
C          XM        R*8      O      MEAN ANOMALY (DEGREES)             00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     RECEL IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000400
C                                                                       00000410
C         INSERT                                                        00000420
C         MODE DRIVERS                                                  00000430
C                                                                       00000440
C                                                                       00000450
C                                                                       00000460
C     NO SUBROUTINES ARE CALLED BY RECEL.                               00000470
C                                                                       00000480
C                                                                       00000490
C                                                                       00000500
C     RECEL NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000510
C         ALL INPUT AN OUTPUT IS THROUGH THE CALLING SEQUENCE.          00000520
C                                                                       00000530
C                                                                       00000540
C                                                                       00000550
C                                                                       00000560
C                                                                       00000570
      ONE=1.D0                                                          00000580
      TWO=2.D0                                                          00000590
      WW(1)=R(2)*V(3)-R(3)*V(2)                                         00000600
      WW(2)=R(3)*V(1)-R(1)*V(3)                                         00000610
      WW(3)=R(1)*V(2)-R(2)*V(1)                                         00000620
      C=DSQRT(WW(1)**2+WW(2)**2+WW(3)**2)                               00000630
      WW(1)=WW(1)/C                                                     00000640
      WW(2)=WW(2)/C                                                     00000650
      WW(3)=WW(3)/C                                                     00000660
      XNU(1)=-WW(2)                                                     00000670
      XNU(2)=WW(1)                                                      00000680
      XNUM=DSQRT(WW(2)**2+WW(1)**2)                                     00000690
      P=C*C/U                                                           00000700
      RM=DSQRT(R(1)**2+R(2)**2+R(3)**2)                                 00000710
      VM=DSQRT(V(1)**2+V(2)**2+V(3)**2)                                 00000720
      RD=(R(1)*V(1)+R(2)*V(2)+R(3)*V(3))                                00000730
C********SOLVE FOR ELEM(1)                                              00000740
      ELEM(1)=RM/(TWO-RM*VM*VM/U)                                       00000750
C********SOLVE FOR ELEM(2)                                              00000760
      ELEM(2)=DSQRT(DABS(ONE-P/ELEM(1)))                                00000770
C********SOLVE FOR ELEM(3)                                              00000780
      ELEM(3)=DARCOS(WW(3))*RAD                                         00000790
C********SOLVE FOR ELEM(6)                                              00000800
      IF(ELEM(2).LT.1.D-06) GO TO 11                                    00000810
      CTA=(P-RM)/(ELEM(2)*RM)                                           00000820
      STA=RD*C/(ELEM(2)*U*RM)                                           00000830
      GO TO 8                                                           00000840
   11 ELEM(2)=0.D0                                                      00000850
      IF(DABS(ELEM(3)).LT.1.D-06) GO TO 9                               00000860
      XNUP(1)=-WW(3)*WW(1)                                              00000870
      XNUP(2)=-WW(3)*WW(2)                                              00000880
      XNUP(3)=WW(1)**2+WW(2)**2                                         00000890
      XNUPM=DSQRT(XNUP(1)**2+XNUP(2)**2+XNUP(3)**2)                     00000900
      CTA=(R(1)*XNU(1)+R(2)*XNU(2))/(RM*XNUM)                           00000910
      STA=(R(1)*XNUP(1)+R(2)*XNUP(2)+R(3)*XNUP(3))/(RM*XNUPM)           00000920
      GO TO 8                                                           00000930
    9 CTA=R(1)/RM                                                       00000940
      STA=R(2)/RM                                                       00000950
    8 ELEM(6)=DATAN2(STA,CTA)*RAD                                       00000960
      IF(ELEM(6).LT.0.D0) ELEM(6)=ELEM(6)+360.D0                        00000970
C                                                                       00000980
C********SOLVE FOR ELEM(4)                                              00000990
C********IF ELEM(3)=0, ELEM(4)=0                                        00001000
C                                                                       00001010
      ELEM(4)=0.D0                                                      00001020
      IF(DABS(ELEM(3)).LT.1.D-06) GO TO 4                               00001030
      ELEM(4)=DATAN2(WW(1),-WW(2))*RAD                                  00001040
      IF(ELEM(4).LT.0.D0) ELEM(4)=ELEM(4)+360.D0                        00001050
C                                                                       00001060
C********SOLVE FOR ELEM(5)                                              00001070
C********IF ELEM(2)=0, ELEM(5)=0                                        00001080
C                                                                       00001090
    4 ELEM(5)=0.D0                                                      00001100
      IF(ELEM(2).LT.1.D-06) GO TO 7                                     00001110
      F=VM**2-U/RM                                                      00001120
      DO 10 I=1,3                                                       00001130
   10 XL(I)=F*R(I)-RD*V(I)                                              00001140
      DNUL=XNU(1)*XL(1)+XNU(2)*XL(2)                                    00001150
      XLM=DSQRT(XL(1)**2+XL(2)**2+XL(3)**2)                             00001160
      IF(DABS(ELEM(3)).LT.1.D-06) GO TO 5                               00001170
      ELEM(5)=DARCOS(DNUL/(XNUM*XLM))*RAD                               00001180
      ELEM(5)=DSIGN(ELEM(5),XL(3))                                      00001190
      GO TO 7                                                           00001200
    5 CW=XL(1)/XLM                                                      00001210
      SW=XL(2)/XLM                                                      00001220
      ELEM(5)=DATAN2(SW,CW)*RAD                                         00001230
    7 IF(ELEM(5).LT.0.D0) ELEM(5)=ELEM(5)+360.D0                        00001240
      Q=ELEM(6)/RAD                                                     00001250
      IF(ELEM(1)) 110,50,50                                             00001260
C********SOLVE FOR TFP ON AN ELLIPTIC ORBIT                             00001270
   50 CONTINUE                                                          00001280
      DIV=ONE+ELEM(2)*DCOS(Q)                                           00001290
      COSEA=(ELEM(2)+DCOS(Q))/DIV                                       00001300
      SINEA=DSQRT(ONE-ELEM(2)**2)*DSIN(Q)/DIV                           00001310
      EA=DATAN2(SINEA,COSEA)                                            00001320
      AVA=EA-ELEM(2)*DSIN(EA)                                           00001330
      IF(AVA.LT.0.D0) AVA=AVA+360.D0/RAD                                00001340
      XM=AVA*RAD                                                        00001350
      TFP=AVA/DSQRT(U/ELEM(1)**3)                                       00001360
      GO TO 20                                                          00001370
C********SOLVE FOR TFP ON A HYPERBOLIC ORBIT                            00001380
  110 CONTINUE                                                          00001390
      TANG=DSQRT((ELEM(2)-ONE)/(ELEM(2)+ONE))*DSIN(Q/TWO)/DCOS(Q/TWO)   00001400
      SINHF=(TWO*TANG)/(ONE-TANG*TANG)                                  00001410
      AUXF=DLOG(SINHF+DSQRT(SINHF*SINHF+ONE))                           00001420
      Z=ELEM(2)*SINHF-AUXF                                              00001430
      XM=Z*RAD                                                          00001440
      TFP=DSQRT(-ELEM(1)**3/U)*Z                                        00001450
   20 RETURN                                                            00001460
      END                                                               00001470
C          DATA SET ROT2XY     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE ROT2XY(A,RPRIME,R)                                     00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE ROT2XY (A,RPRIME,R)                                    00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF ROT2XY IS TO DO A COORDINATE TRANSFORMATION FROM A 00000090
C         FRAME ROTATING ABOUT THE Z AXIS TO A REST FRAME.              00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          A         R*8      I      ROTATION ANGLE                     00000180
C          RPRIME(3) R*8      I      VECTOR IN ROTATING FRAME           00000190
C          R(3)      R*8      O      VECTOR IN REST FRAME               00000200
C                                                                       00000210
C                                                                       00000220
C                                                                       00000230
C     ROT2XY IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000240
C                                                                       00000250
C         MODE DRIVERS                                                  00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     NO SUBROUTINES ARE CALLED BY ROT2XY.                              00000300
C                                                                       00000310
C                                                                       00000320
C                                                                       00000330
C     ROT2XY NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000340
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C        * *         *                          *     *      *          00000390
C       *   *       *                            *   *        *         00000400
C       * X *       *  COS(A)     -SIN(A)     0  *   * XPRIME *         00000410
C       *   *       *                            *   *        *         00000420
C       * Y *   =   *  SIN(A)      COS(A)     0  *   * YPRIME *         00000430
C       *   *       *                            *   *        *         00000440
C       * Z *       *    0           0        1  *   * ZPRIME *         00000450
C       *   *       *                            *   *        *         00000460
C        * *         *                          *     *      *          00000470
      DIMENSION RPRIME(3),R(3)                                          00000480
      COSA = DCOS(A)                                                    00000490
      SINA = DSIN(A)                                                    00000500
      R(1) = RPRIME(1) * COSA-RPRIME(2)*SINA                            00000510
      R(2) = RPRIME(1) * SINA + RPRIME(2) * COSA                        00000520
      R(3) = RPRIME(3)                                                  00000530
      RETURN                                                            00000540
      END                                                               00000550
C          DATA SET SEP        AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SEP (SVEC,SATE,HVEC,STIME,ECC,TPER,SMAX,SMIN,SAPA,SAPB)00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C     ROUTINE WRITTEN BY JOHN GRIFFIN, CSC.                             00000030
C                                                                       00000040
C     SUBROUTINE SEP (SVEC,SATE,HVEC,STIME,ECC,TPER,SMAX,SMIN,SAPA,SAPB)00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF SEP IS TO COMPUTE SUN-EARTH SEPARATION ANGLES AS   00000090
C         SEEN FROM A SATELLITE IN EARTH ORBIT.                         00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          SVEC(3)   R*8      I      EARTH-TO-SUN UNIT VECTOR (SAME AS  00000180
C                                       SATELLITE-TO-SUN UNIT VECTOR)   00000190
C          SATE(3)   R*8      I      SATELLITE-TO-EARTH UNIT VECTOR AT  00000200
C                                       ORBIT APOGEE                    00000210
C          HVEC(3)   R*8      I      ORBITAL ANGULAR MOMENTUM UNIT      00000220
C                                       VECTOR                          00000230
C          STIME     R*8      I      TIME AT WHICH SATELLITE BEGINS     00000240
C                                       TRAVERSING ORBITAL SEGMENT OF   00000250
C                                       INTEREST (SECONDS FROM PERIGEE  00000260
C                                       PASSAGE)                        00000270
C          ECC       R*8      I      ORBITAL ECCENTRICITY               00000280
C          TPER      R*8      I      ORBITAL PERIOD (SECONDS)           00000290
C          SMAX      R*8      O      MAXIMUM SUN-EARTH SEPARATION ANGLE 00000300
C                                       ALONG ORBITAL SEGMENT (RADIANS) 00000310
C          SMIN      R*8      O      MINIMUM SUN-EARTH SEPARATION ANGLE 00000320
C                                       ALONG ORBITAL SEGMENT (RADIANS) 00000330
C          SAPA      R*8      O      SUN-EARTH SEPARATION ANGLE AT      00000340
C                                       APOGEE (RADIANS)                00000350
C          SAPB      R*8      O      SUN-EARTH SEPARATION ANGLE AT      00000360
C                                       STIME (RADIANS)                 00000370
C                                                                       00000380
C                                                                       00000390
C     SEP IS CALLED BY THE FOLLOWING SUBROUTINE.                        00000400
C                                                                       00000410
C         ESSO                                                          00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C     THE FOLLOWING SUBROUTINES ARE CALLED BY SEP.                      00000460
C                                                                       00000470
C         JOHANN    XPROD                                               00000480
C                                                                       00000490
C                                                                       00000500
C                                                                       00000510
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY SEP.               00000520
C                                                                       00000530
C         DOT                                                           00000540
C                                                                       00000550
C                                                                       00000560
C                                                                       00000570
C     SEP NEITHER USES NOR ALTERS VARIABLES IN COMMON.                  00000580
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000590
C                                                                       00000600
C                                                                       00000610
C                                                                       00000620
      DIMENSION SVEC(3), SATE(3), HVEC(3), SVECS(3), C(3),              00000630
     2          CXYZ(3), PXYZ(3), BETAV(3)                              00000640
      DATA XTOL,XPI,D2R/1.D-4,3.1415926535897932D0,0.017453292519943D0/ 00000650
C     CALCULATE THE SAT-EARTH UNIT VECTOR BETA AT TIME STIME            00000660
      XMANOM = STIME * (2.D0*XPI/TPER)/D2R                              00000670
      CALL JOHANN (ECC,XMANOM,XTOL,TA,K)                                00000680
      BETA = TA * D2R  -  XPI                                           00000690
      IF(BETA.LT.0.D0)BETA=BETA+2.D0*XPI                                00000700
      BETA=DMOD(BETA,2.D0*XPI)                                          00000710
C     TRANSFORM INERTIAL VECTORS TO SATELITE CENTERED COORDINATE SYSTEM 00000720
      CALL XPROD (HVEC,SATE,C,CMAG,1)                                   00000730
      SVECS(1)=DOT(SVEC,SATE)                                           00000740
      SVECS(2)=DOT(SVEC,C)                                              00000750
      SVECS(3)=DOT(SVEC,HVEC)                                           00000760
C     COMPUTE THE BETA VECTOR                                           00000770
      BETAV(1)=DCOS(BETA)                                               00000780
      BETAV(2)=DSIN(BETA)                                               00000790
      BETAV(3)=0.0D0                                                    00000800
      XMAGC1=DSQRT(SVECS(1)*SVECS(1)+SVECS(2)*SVECS(2))                 00000810
      CXYZ(1)=-SVECS(2)/XMAGC1                                          00000820
      CXYZ(2)= SVECS(1)/XMAGC1                                          00000830
      CXYZ(3)= 0.0D0                                                    00000840
      XMAG2=DSQRT(CXYZ(1)*CXYZ(1)+CXYZ(2)*CXYZ(2))                      00000850
      PXYZ(1)=CXYZ(2)/XMAG2                                             00000860
      PXYZ(2)=-CXYZ(1)/XMAG2                                            00000870
      PXYZ(3)=0.0D0                                                     00000880
C     COMPUTE PROJECTION OF SVECS ONTO THE ORBIT PLANE                  00000890
      SINTH=PXYZ(2)                                                     00000900
      COSTH=PXYZ(1)                                                     00000910
      THETA=DATAN2(SINTH,COSTH)                                         00000920
      IF(THETA.LT.0.D0)THETA=THETA+2.D0*XPI                             00000930
      THETA=DMOD(THETA,2.D0*XPI)                                        00000940
C     SEPARTION ANGLE AT APOHEE (SAPA)                                  00000950
      SAPA=DARCOS(SVECS(1))                                             00000960
C     SEPARATION ANGLE AT TIME STIME                                    00000970
      SAPB=DARCOS(DOT(SVECS,BETAV))                                     00000980
C     FIND MIN. AND MAX. OF SAPA AND SAPB                               00000990
      SMIN=DMIN1(SAPA,SAPB)                                             00001000
      SMAX=DMAX1(SAPA,SAPB)                                             00001010
C     COMPUTE MIN.AND.MAX                                               00001020
      DOTSP=DOT(SVECS,PXYZ)                                             00001030
      IF(BETA.GT.XPI)GOTO 100                                           00001040
      IF(THETA.GE.0.D0.AND.THETA.LE.BETA)SMIN=DARCOS(DOTSP)             00001050
      IF(THETA.GE.XPI.AND.THETA.LE.(BETA+XPI))SMAX=XPI-DARCOS(DOTSP)    00001060
      GOTO 200                                                          00001070
C     ANGLE BETA IS.GT. XPI                                             00001080
  100 IF(THETA.GE.BETA.AND.THETA.LE.(2.D0*XPI))SMIN=DARCOS(DOTSP)       00001090
      IF(THETA.GE.(BETA-XPI).AND.THETA.LE.XPI)SMAX=XPI-DARCOS(DOTSP)    00001100
  200 RETURN                                                            00001110
      END                                                               00001120
C          DATA SET SHALE      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SHALE(KSHAD,TENTER,TEXIT,ARC,SH1IN,SH2IN,SH1DUR,SH2DUR)00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE SHALE (KSHAD,TENTER,TEXIT,ARC,SH1IN,SH2IN,SH1DUR,      00000050
C                       SH2DUR)                                         00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF SHALE IS TO COMPUTE SHADOW INCIDENCES AND DURATIONS00000100
C         ON ANY SPECIFIED SEGMENT OF AN ORBIT WHEN THE SHADOW TIMES FOR00000110
C         THE ORBIT AS A WHOLE ARE KNOWN.                               00000120
C                                                                       00000130
C                                                                       00000140
C                                                                       00000150
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000160
C                                                                       00000170
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000180
C                                                                       00000190
C          KSHAD     I*4      I      SHADOW FLAG --                     00000200
C                                       .EQ.0 IF NO SHADOW IN ORBIT     00000210
C                                       .NE.0 IF THERE IS SHADOW IN     00000220
C                                          ORBIT                        00000230
C          TENTER    R*8      I      TIME ALONG A FULL ORBITAL          00000240
C                                       REVOLUTION FROM BEGINNING OF    00000250
C                                       SEGMENT TO SHADOW ENCOUNTER     00000260
C                                       POINT                           00000270
C          TEXIT     R*8      I      TIME ALONG A FULL REVOLUTION FROM  00000280
C                                       BEGINNING OF SEGMENT TO ENDPOINT00000290
C                                       OF SHADOW                       00000300
C          ARC       R*8      I      TRAVERSAL TIME OF ORBITAL SEGMENT  00000310
C          SH1IN     R*8      O      TIME FROM BEGINNING OF SEGMENT TO  00000320
C                                       FIRST SHADOW ENCOUNTER ALONG THE00000330
C                                       SEGMENT                         00000340
C          SH2IN     R*8      O      TIME FROM BEGINNING OF SEGMENT TO A00000350
C                                       SECOND SHADOW ENCOUNTER ALONG   00000360
C                                       THE SEGMENT                     00000370
C          SH1DUR    R*8      O      DURATION OF FIRST SHADOW OCCURENCE 00000380
C                                       ALONG THE SEGMENT               00000390
C          SH2DUR    R*8      O      DURATION OF SECOND SHADOW OCCURENCE00000400
C                                       ALONG THE SEGMENT               00000410
C                                                                       00000420
C                                                                       00000430
C                                                                       00000440
C     SHALE IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000450
C                                                                       00000460
C         OFSHOR                                                        00000470
C                                                                       00000480
C                                                                       00000490
C                                                                       00000500
C     NO SUBROUTINES ARE CALLED BY SHALE.                               00000510
C                                                                       00000520
C                                                                       00000530
C                                                                       00000540
C     SHALE NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000550
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000560
C                                                                       00000570
C                                                                       00000580
C                                                                       00000590
      IF (KSHAD .EQ. 0) GO TO 300                                       00000600
      IF((ARC .LE. TENTER) .AND. (ARC .LE. TEXIT)) GO TO 300            00000610
      IF((TENTER .LE. ARC) .AND. (TENTER .LE. TEXIT)) GO TO 100         00000620
      IF((TEXIT .LE. ARC) .AND. (TEXIT .LE. TENTER)) GO TO 200          00000630
  100 SH1IN = TENTER                                                    00000640
      SH2IN = TENTER                                                    00000650
      IF(ARC .GE. TEXIT) SH1DUR = TEXIT-TENTER                          00000660
      IF(ARC .LT. TEXIT) SH1DUR = ARC - TENTER                          00000670
      SH2DUR = 0.D0                                                     00000680
      GO TO 400                                                         00000690
  200 SH2DUR = ARC - TENTER                                             00000700
      IF(ARC .LE. TENTER) SH2DUR = 0.D0                                 00000710
      SH1DUR = TEXIT                                                    00000720
      SH1IN = 0.D0                                                      00000730
      SH2IN = TENTER                                                    00000740
      GO TO 400                                                         00000750
  300 SH1IN = ARC                                                       00000760
      SH2IN = ARC                                                       00000770
      SH1DUR = 0.D0                                                     00000780
      SH2DUR = 0.D0                                                     00000790
      IF(KSHAD .EQ. 0) GO TO 400                                        00000800
      IF(TEXIT .GT. TENTER) GO TO 400                                   00000810
      SH1IN = 0.D0                                                      00000820
      SH1DUR = ARC                                                      00000830
  400 RETURN                                                            00000840
      END                                                               00000850
C          DATA SET SHORB2     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SHORB2(ELM,SUN,RC,RSUN,JUMB,JPEN,UMBIN,UMBOUT,PENIN,   00000010
     1 PENOUT)                                                          00000020
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000030
      DIMENSION ELM(6),SUN(3),VEC(3),COEF(5),ROOTS(4),DUMROT(3,3)       00000040
      DATA PI/3.141592653589793D0/,ETOL/0.00150D0/                      00000050
C                                                                       00000060
C                                                                       00000070
C     SUBROUTINE SHORB2 (ELM,SUN,RC,RSUN,JUMB,JPEN,UMBIN,UMBOUT,PENIN,  00000080
C                        PENOUT)                                        00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     THE PURPOSE OF SHORB2 IS TO DETERMINE THE INTERSECTIONS OF A      00000130
C         GIVEN ORBIT WITH THE UMBRA AND THE PENUMBRA OF THE CENTRAL    00000140
C         PLANET.                                                       00000150
C                                                                       00000160
C                                                                       00000170
C                                                                       00000180
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000190
C                                                                       00000200
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000210
C                                                                       00000220
C          ELM(6)    R*8      I      ORBITAL ELEMENTS --                00000230
C           (1)                         SEMI-LATUS RECTUM               00000240
C           (2)                         ECCENTRICITY                    00000250
C           (3)                         TRUE ANOMALY (NOT USED)         00000260
C           (4)                         ARGUMENT OF PERIAPSIS (RADIANS) 00000270
C           (5)                         INCLINATION (RADIANS)           00000280
C           (6)                         RIGHT ASCENSION OF ASCENDING    00000290
C                                          NODE (RADIANS)               00000300
C          SUN(3)    R*8      I         SUN POSITION VECTOR WITH RESPECT00000310
C                                          TO CENTRAL PLANET (SAME      00000320
C                                          COORDINATE SYSTEM AS THAT FOR00000330
C                                          ORBITAL ELEMENTS)            00000340
C          RC        R*8      I         RADIUS OF CENTRAL PLANET (SAME  00000350
C                                          UNITS AS ELM(1))             00000360
C          RSUN      R*8      I         RADIUS OF SUN (SAME UNITS AS RC)00000370
C          JUMB,JPEN I*4     I/O     SHADOW INPUT FLAGS --              00000380
C                                       .NE.0, DO PENUMBRAL, UMBRAL     00000390
C                                              CALCULATIONS             00000400
C                                       .EQ.0, DO NOT DO THE            00000410
C                                              CALCULATIONS             00000420
C                                    SHADOW OUTPUT FLAGS --             00000430
C                                       =1, IMPACT OR ESCAPE CENTRAL    00000440
C                                           PLANET                      00000450
C                                       =2, NO SHADOW POSSIBLE (MAXIMUM 00000460
C                                           SHADOW DISTANCE LESS THAN   00000470
C                                           MINIMUM DISTANCE TO ORBIT)  00000480
C                                       =3, NO REAL SOLUTIONS ON NIGHT  00000490
C                                           SIDE OF TERMINATOR          00000500
C                                       =4, SOLUTIONS FOUND             00000510
C                                       =5, NO REAL SOLUTIONS           00000520
C                                    NOTE--IF JUMB (JPEN) .NE.4 ON      00000530
C                                          RETURN, THE OUTPUT QUANTITIES00000540
C                                          BELOW ARE SET TO ZERO.       00000550
C          UMBIN     R*8      O      TRUE ANOMALY ALONG ORBIT OF UMBRAL 00000560
C                                       ENTRANCE (RADIANS)              00000570
C          UMBOUT    R*8      O      TRUE ANOMALY ALONG ORBIT OF UMBRAL 00000580
C                                       EXIT (RADIANS)                  00000590
C          PENIN     R*8      O      TRUE ANOMALY ALONG ORBIT OF        00000600
C                                       PENUMBRAL ENTRANCE (RADIANS)    00000610
C          PENOUT    R*8      O      TRUE ANOMALY ALONG ORBIT OF        00000620
C                                       PENUMBRAL EXIT (RADIANS)        00000630
C                                                                       00000640
C                                                                       00000650
C     SHORB2 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000660
C                                                                       00000670
C         OFSHOR                                                        00000680
C                                                                       00000690
C                                                                       00000700
C                                                                       00000710
C     THE FOLLOWING SUBROUTINES ARE CALLED BY SHORB2.                   00000720
C                                                                       00000730
C         QUARTC    ROTATE (ENTRY POINT OF MVTRN)                       00000740
C                                                                       00000750
C                                                                       00000760
C                                                                       00000770
C     SHORB2 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000780
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000790
C                                                                       00000800
C                                                                       00000810
C                                                                       00000820
       P = ELM(1)                                                       00000830
       E = ELM(2)                                                       00000840
      KUMB = JUMB                                                       00000850
      KPEN = JPEN                                                       00000860
      UMBIN = 0.D0                                                      00000870
      UMBOUT = 0.D0                                                     00000880
      PENIN = 0.D0                                                      00000890
      PENOUT = 0.D0                                                     00000900
      KOUNT = 0                                                         00000910
      ROMIN = P/(1.D0+E)                                                00000920
      IF (ROMIN .GT. RC .AND. E .LT. 1.D0) GO TO 11                     00000930
C     VEHICLE IMPACTS OR ESCAPES CENTRAL PLANET                         00000940
      JUMB = 1                                                          00000950
      JPEN = 1                                                          00000960
      GO TO 999                                                         00000970
   11 IF (KUMB .EQ. 0) GO TO 99                                         00000980
    1 IF (KOUNT . NE. 0 .AND. KPEN.EQ.0) GO TO 99                       00000990
      IF(KUMB .NE. 0 .AND.KOUNT.EQ.1) GO TO 12                          00001000
C     INITIALIZE FOR UMBRA                                              00001010
      DIS = DSQRT(SUN(1)**2 + SUN(2)**2 + SUN(3)**2)                    00001020
      SA =(RSUN - RC)/DIS                                               00001030
      CA = DSQRT(1.D0-SA*SA)                                            00001040
      CW = DCOS(ELM(4))                                                 00001050
      SW = DSIN(ELM(4))                                                 00001060
      CI = DCOS(ELM(5))                                                 00001070
      SI = DSIN(ELM(5))                                                 00001080
      CO = DCOS(ELM(6))                                                 00001090
      SO = DSIN(ELM(6))                                                 00001100
      DUMROT(1,1) = CW*CO - SO*SW*CI                                    00001110
      DUMROT(1,2) =CW*SO + CO*SW*CI                                     00001120
      DUMROT(1,3) = SW*SI                                               00001130
      DUMROT(2,1) =-SW*CO-SO*CW*CI                                      00001140
      DUMROT(2,2) =-SW*SO + CO*CW*CI                                    00001150
      DUMROT(2,3) = CW*SI                                               00001160
      DUMROT(3,1) = SI*SO                                               00001170
      DUMROT(3,2) =-SI*CO                                               00001180
      DUMROT(3,3) = CI                                                  00001190
      CALL ROTATE(1,DUMROT,SUN,VEC)                                     00001200
      DO 13 J=1,3                                                       00001210
   13 VEC(J) =-VEC(J)/DIS                                               00001220
      CD = DSQRT(VEC(1)**2+VEC(2)**2)                                   00001230
      SD = DSQRT(1.D0-CD*CD)                                            00001240
      CG = VEC(1)/CD                                                    00001250
      SG = VEC(2)/CD                                                    00001260
      GAMA = DATAN2(VEC(2),VEC(1))                                      00001270
      ALFA = DARSIN(SA)                                                 00001280
      IF(KOUNT.EQ.0) GO TO 2                                            00001290
C     CHANGE FOR PENUMBRA                                               00001300
   12 SA = (RSUN + RC)/DIS                                              00001310
      CA = DSQRT(1.D0-SA*SA)                                            00001320
      ALFA = DARSIN(SA)                                                 00001330
      CG = -CG                                                          00001340
      SG=-SG                                                            00001350
      GAMA = GAMA - PI                                                  00001360
    2 CONTINUE                                                          00001370
C     CHECK FOR NO POSSIBLE SHADOW                                      00001380
C     DETERMINE MAX DISTANCE TO SHADOW                                  00001390
      RSMAX = (SA*CD + SD*CA)                                           00001400
      IF(KOUNT .EQ. 1) RSMAX = (SD*CA - SA*CD)                          00001410
      IF(RSMAX .GT. 1.D-15) GO TO 21                                    00001420
C     MAXIMUM PENUMBRA DISTANCE IS INFINITE                             00001430
      RSMAX = 1.D20                                                     00001440
      GO TO 22                                                          00001450
   21 RSMAX = RC / RSMAX                                                00001460
      ROMIN = P/(1.D0+E)                                                00001470
      IF(RSMAX .GT. ROMIN) GO TO 22                                     00001480
C     NO SHADOW POSSIBLE                                                00001490
      IF (KOUNT .EQ. 0) JUMB = 2                                        00001500
      IF(KOUNT .EQ.1)JPEN = 2                                           00001510
      GO TO 99                                                          00001520
   22 IF (E .LT. ETOL) GO TO 993                                        00001530
C                                                                       00001540
C     SET UP COEFFICIENTS FOR QUARTIC IN COS(SI)                        00001550
C                                                                       00001560
      A = (P*SA*CD-RC*E*CG)**2+(RC*E*SG)**2+(P*CA*CD)**2                00001570
      B = 2.D0*RC*(P*SA*CD-RC*E*CG)                                     00001580
      C = RC*RC*(1.D0-(E*SG)**2)-(P*CA)**2                              00001590
      D = 2.D0*P*RC*E*SG*CA                                             00001600
      COEF(1) = C*C-D*D                                                 00001610
      COEF(2) = -2.D0*B*C                                               00001620
      COEF(3) = 2.D0*A*C+B*B+D*D*(1.D0+CD*CD)                           00001630
      COEF(4) = -2.D0*A*B                                               00001640
      COEF(5) = A*A - (D*CD)**2                                         00001650
      NROOTS = 4                                                        00001660
      CALL QUARTC(COEF,ROOTS,NROOTS)                                    00001670
      NUM = NROOTS + 1                                                  00001680
      GO TO (4,4,5,4,5),NUM                                             00001690
    4 CONTINUE                                                          00001700
C     NO REAL ROOTS(ONE OR THREE NOT POSSIBLE)                          00001710
      IF(KOUNT .EQ. 0) JUMB = 5                                         00001720
      IF(KOUNT .EQ. 1) JPEN = 5                                         00001730
      GO TO 99                                                          00001740
    5 CONTINUE                                                          00001750
C     TWO OR FOUR REAL ROOTS                                            00001760
C     CHECK QUADRANTS OF SOLUTIONS                                      00001770
      DO 51 J=1,NROOTS                                                  00001780
      SSI = DSQRT(1.D0-ROOTS(J)**2)                                     00001790
      CBETA = CD*ROOTS(J)                                               00001800
      SBETA = DSQRT(1.D0-CBETA**2)                                      00001810
      RPLS = P/(1.D0+E*(ROOTS(J)*CG-SSI*SG))                            00001820
      RMNS = P/(1.D0+E*(ROOTS(J)*CG+SSI*SG))                            00001830
      RSHAD = RC/(SA*CBETA+CA*SBETA)                                    00001840
      DELRP = DABS(RPLS-RSHAD)                                          00001850
      DELRM = DABS(RMNS - RSHAD)                                        00001860
      IF(DELRM .LT. DELRP) SSI=-SSI                                     00001870
C     REPLACE COS(SI) WITH SI                                           00001880
   51 ROOTS(J) = DATAN2(SSI,ROOTS(J))                                   00001890
      IF (KOUNT .EQ. 1) GO TO 6                                         00001900
C                                                                       00001910
C     SELECT ANGLES FOR UMBRAL BOUNDARIES                               00001920
C                                                                       00001930
      DO 52 J=1,NROOTS                                                  00001940
      DO 52 K=J,NROOTS                                                  00001950
      IF(DABS(ROOTS(J)).LT.DABS(ROOTS(K))) GO TO 52                     00001960
      TEMP = ROOTS(J)                                                   00001970
      ROOTS(J) = ROOTS(K)                                               00001980
      ROOTS(K) = TEMP                                                   00001990
   52 CONTINUE                                                          00002000
C     CHECK THAT SOLUTIONS ARE ON NITE SIDE OF UMBRAL TERMINATOR        00002010
      TEST = 0.5D0*PI-ALFA                                              00002020
      IF(DABS(ROOTS(1)).LT.TEST) GO TO 53                               00002030
C     NO UMBRAL INTERSECTIONS                                           00002040
      JUMB = 3                                                          00002050
      GO TO 99                                                          00002060
   53 UMBIN = ROOTS(1)                                                  00002070
      UMBOUT = ROOTS(2)                                                 00002080
      IF(UMBOUT .GT. UMBIN) GO TO 54                                    00002090
      UMBIN = ROOTS(2)                                                  00002100
      UMBOUT = ROOTS(1)                                                 00002110
   54 JUMB = 4                                                          00002120
      GO TO 99                                                          00002130
C     SELECT ANGLES FOR PENUMBRAL BOUNDARIES                            00002140
C     ( ANGLES WITH MAX ABSOLUTE VALUES )                               00002150
    6 DO 61 J=1,NROOTS                                                  00002160
      DO 61 K=J,NROOTS                                                  00002170
      IF (DABS(ROOTS(J)).GT.DABS(ROOTS(K))) GO TO 61                    00002180
      TEMP = ROOTS(J)                                                   00002190
      ROOTS(J) = ROOTS(K)                                               00002200
      ROOTS(K) = TEMP                                                   00002210
   61 CONTINUE                                                          00002220
C     CHECK TO MAKE SURE THAT SOLUTIONS ARE ON NITE SIDE                00002230
C     OF PENUMBRAL TERMINATOR                                           00002240
      TEST = 0.5D0*PI+ALFA                                              00002250
      IF(DABS(ROOTS(1)).GT.TEST) GO TO 62                               00002260
C     NO PENUMBRAL INTERSECTIONS                                        00002270
      JPEN = 3                                                          00002280
      GO TO 99                                                          00002290
   62 PENIN = ROOTS(1)                                                  00002300
      PENOUT = ROOTS(2)                                                 00002310
      IF(PENIN.GT.PENOUT) GO TO 63                                      00002320
      PENIN = ROOTS(2)                                                  00002330
      PENOUT = ROOTS(1)                                                 00002340
   63 JPEN = 4                                                          00002350
   99 KOUNT = KOUNT + 1                                                 00002360
      IF(JUMB .NE. 4 .OR. KOUNT .NE. 1) GO TO 991                       00002370
      UMBIN = UMBIN + GAMA                                              00002380
      UMBOUT = UMBOUT + GAMA                                            00002390
  991 IF (JPEN.NE.4.OR.KOUNT.NE.2) GO TO 992                            00002400
      PENIN = PENIN + GAMA                                              00002410
      PENOUT = PENOUT + GAMA                                            00002420
  992 IF(KOUNT .EQ. 2) GO TO 999                                        00002430
      IF(KOUNT .EQ. 1 .AND. KPEN .NE. 0) GO TO 1                        00002440
      GO TO 999                                                         00002450
C     APPROXIMATE SOLUTION FOR NEAR-CIRCULAR ORBITS                     00002460
  993 CBETA = RC*SA/ROMIN                                               00002470
      SBETA = CA*DSQRT(1.D0-(RC/ROMIN)**2)                              00002480
      IF (KOUNT .NE. 0) GO TO 994                                       00002490
      CBETA = CBETA +SBETA                                              00002500
C     UMBRA                                                             00002510
      SI = DARCOS(CBETA/CD)                                             00002520
      UMBIN = -SI                                                       00002530
      UMBOUT = SI                                                       00002540
      JUMB = 4                                                          00002550
      GO TO 99                                                          00002560
  994 CBETA = CBETA - SBETA                                             00002570
C     PENUMBRA                                                          00002580
      SI = DARCOS(CBETA/CD)                                             00002590
      PENIN=SI                                                          00002600
      PENOUT=-SI                                                        00002610
      JPEN = 4                                                          00002620
      GO TO 99                                                          00002630
  999 RETURN                                                            00002640
      END                                                               00002650
C          DATA SET SPILL      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SPILL (S,N,JLINES,JRECS,JEND,/JAV/)                    00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE SPILL (S,N,JLINES,JRECS,JEND,/JAV/)                    00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF SPILL IS TO PRINT ONE LINE OF DATA (UP TO 11 OUTPUT00000100
C         PARAMETERS) ON EACH OF AS MANY AS 7 OUTPUT UNITS. SPILL ALSO  00000110
C         WRITES THIS SAME DATA, UP TO 77 VALUES, IN LINEAR SEQUENCE    00000120
C         ONTO A DATA TAPE FOR USE WITH A CALCOMP PLOT PACKAGE.         00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          S(N)      R*8      I      ARRAY CONTAINING THE VALUES OF ALL 00000210
C                                       N POSSIBLE OUTPUT PARAMETERS    00000220
C          N         I*4      I      TOTAL NUMBER OF OUTPUT PARAMETERS  00000230
C                                       FROM WHICH USER CAN CHOOSE      00000240
C                                       (DEPENDS ON MODE)               00000250
C          JLINES    I*4      I      COUNTER USED FOR PAGING AND COLUMN-00000260
C                                       HEADING THE PRINTOUT (IF        00000270
C                                       MOD(JLINES-1,50)=0, START A NEW 00000280
C                                       PAGE)                           00000290
C          JRECS     I*4      I      NUMBER OF RECORDS WRITTEN SO FAR,  00000300
C                                       INCLUDING THIS ONE              00000310
C          JEND      I*4      I      TOTAL NUMBER OF RECORDS TO BE      00000320
C                                       WRITTEN ON THE DATA TAPE BY THIS00000330
C                                       STACKED CASE (WHEN JRECS=JEND AN00000340
C                                       END OF FILE IS WRITTEN)         00000350
C          JAV       I*4      I      ASSOCIATED VARIABLE FOR DISK DATA  00000360
C                                       SET                             00000370
C                                                                       00000380
C                                                                       00000390
C     SPILL IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000400
C                                                                       00000410
C         MODE DRIVERS                                                  00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C     NO SUBROUTINES ARE CALLED BY SPILL.                               00000460
C                                                                       00000470
C                                                                       00000480
C                                                                       00000490
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000500
C                                                                       00000510
C         COMMON VARIABLES USED                                         00000520
C                                                                       00000530
C         C(11,7)   JCOUNT(7) MDISK                                     00000540
C         IP(11,7)  M(7)      MPLOT                                     00000550
C                                                                       00000560
C                                                                       00000570
C                                                                       00000580
      COMMON/CODES/OUT(11,7),M(7),MPLOT,MDISK                           00000590
      COMMON/SP3/   C(11,7), IP(11,7), JCOUNT(7)                        00000600
      DIMENSION P(11,7),PLOT(77),S(N)                                   00000610
C                                                                       00000620
C$C$  STORE PART OF S ARRAY ON DISK (AS 1 RECORD OF UP TO 33 WORDS).    00000630
C$C$  IF (MDISK .NE. 0) WRITE (MDISK'JAV) (PDISK(J),J=1,33)             00000640
C                                                                       00000650
C*****WRITE COLUMN HEADINGS.                                            00000660
      JERK = MOD(JLINES-1,50)                                           00000670
      IF (JERK .NE. 0) GO TO 4                                          00000680
      DO 2 JJ = 1,7                                                     00000690
      IF (M(JJ) .EQ. 0) GO TO 4                                         00000700
      MU = M(JJ)                                                        00000710
      JC = JCOUNT(JJ)                                                   00000720
      WRITE (MU,1001) (C(J,JJ),J=1,JC)                                  00000730
      WRITE(MU,1000)                                                    00000740
    2 CONTINUE                                                          00000750
C                                                                       00000760
C*****WRITE OUTPUT DATA TO PRINTER AND DATA TAPE UNITS.                 00000770
    4 KPLOT = 0                                                         00000780
C     LOOP OVER PRINTER UNITS M(JJ).                                    00000790
      DO 20 JJ=1,7                                                      00000800
C     RETURN WHEN 1ST UNIT NOT BEING USED IS ENCOUNTERED.               00000810
      IF (M(JJ) .EQ. 0)  GO TO 25                                       00000820
      MU = M(JJ)                                                        00000830
C     THERE ARE JCOUNT COLUMNS OF OUTPUT DATA PER UNIT. LOOP OVER THEM. 00000840
      JC = JCOUNT(JJ)                                                   00000850
      DO 15 J = 1,JC                                                    00000860
      P(J,JJ) = S(IP(J,JJ))                                             00000870
      KPLOT   = KPLOT + 1                                               00000880
   15 PLOT(KPLOT)  =   P(J,JJ)                                          00000890
   20 WRITE (MU,1002) (P(J,JJ),J=1,JC)                                  00000900
   25 IF (MPLOT .NE. 0)  WRITE (MPLOT) (PLOT(KK),KK=1,KPLOT)            00000910
   30 IF ((MPLOT .NE. 0) .AND. (JRECS .EQ. JEND)) END FILE MPLOT        00000920
      RETURN                                                            00000930
 1000 FORMAT(1H0)                                                       00000940
 1001 FORMAT (1H1, //////////////////11(4X,A8))                         00000950
 1002 FORMAT (1H ,11F12.5)                                              00000960
      END                                                               00000970
C          DATA SET SUNEPH     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SUNEPH (MSUN,JSDAY,JDAY)                               00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE SUNEPH (MSUN,JSDAY,JDAY)                               00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF SUNEPH IS TO COMPUTE AND STORE A SUN POSITION      00000090
C         EPHEMERIS FOR UP TO 510 DAYS AT HALF-DAY INTERVALS.           00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/0        DEFINITION                      00000160
C                                                                       00000170
C          MSUN      I*4      I      UNIT ON WHICH SUN EPHEMERIS IS TO  00000180
C                                       BE PRINTED (IF MSUN=0, NO       00000190
C                                       PRINTOUT)                       00000200
C          JSDAY     I*4      I      FIRST DAY FOR WHICH SUN POSITION IS00000210
C                                       DESIRED (IN WHOLE DAYS SINCE    00000220
C                                       1950.0)                         00000230
C          JDAY      I*4      I      NUMBER OF DAYS OF SUN DATA DESIRED 00000240
C                                       (.LE. 510)                      00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     SUNEPH IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000290
C                                                                       00000300
C         MODE DRIVERS                                                  00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     THE FOLLOWING SUBROUTINES ARE CALLED BY SUNEPH.                   00000350
C                                                                       00000360
C         DATOUT    PCONIK                                              00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     THE VARIABLES APPEARING IN COMMON ARE TABULATED BELOW.            00000410
C                                                                       00000420
C         COMMON VARIABLES COMPUTED                                     00000430
C                                                                       00000440
C           SUN(3,1020)                                                 00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
      DIMENSION SUN(3,1020),SOL(3),V(3)                                 00000490
      COMMON/SOLAR/SUN                                                  00000500
      IF (MSUN .NE. 0) WRITE (MSUN,1000)                                00000510
      JFINAL = JSDAY + JDAY                                             00000520
      DO 10 JJJ = JSDAY,JFINAL,1                                        00000530
      DAY = JJJ                                                         00000540
      CALL DATOUT (DAY,0.D0,D,T,1)                                      00000550
      M = 2*(JJJ-JSDAY) + 1                                             00000560
      CALL PCONIK(3,DAY,0.D0,SOL,V)                                     00000570
      DO 5 K = 1,3                                                      00000580
    5 SUN(K,M) = -SOL(K)                                                00000590
      CALL PCONIK (3,DAY,0.5D0,SOL,V)                                   00000600
      DO 9 K=1,3                                                        00000610
    9 SUN(K,M+1)=-SOL(K)                                                00000620
      MAY=M+1                                                           00000630
      IF (MSUN .NE. 0) WRITE (MSUN,1002) D,DAY, (SUN(KK,M),KK=1,3),     00000640
     2                                          (SUN(KL,MAY),KL=1,3)    00000650
   10 CONTINUE                                                          00000660
      IF (JDAY .GT. 510) GO TO 15                                       00000670
      RETURN                                                            00000680
   15 WRITE(6,1001) JDAY                                                00000690
      IF ((MSUN .NE. 0) .AND. (MSUN .NE. 6)) WRITE (MSUN,1001) JDAY     00000700
 1001 FORMAT(1H0,'SUNEPH WARNING MESSAGE. NUMBER OF DAYS OF SUN EPHEMERI00000710
     2S DATA REQUESTED WAS ', I7, '. SUNEPH ARRAYS CAN HANDLE ONLY 510 D00000720
     3AYS.'/'CHECK SDATE, FDATE INPUT VALUES.')                         00000730
 1000 FORMAT (1H1,'*****************************************************00000740
     2*******SUN EPHEMERIS**********************************************00000750
     3********'/'  DATE',7X,'DAY', 6X,'SUN(X,MIDNIGHT)',3X,             00000760
     4  'SUN(Y,MIDNIGHT)',3X,'SUN(Z,MIDNIGHT)',5X,'SUN(X,N00N)',7X,     00000770
     5  'SUN(Y,NOON)',7X,'SUN(Z,NOON)'/' ')                             00000780
 1002 FORMAT (1H ,F8.2,F10.2,6D18.8)                                    00000790
      RETURN                                                            00000800
      END                                                               00000810
C          DATA SET SUNOCO     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SUNOCO (RES,A,E,INC,NODE,ARGP,ANOMA,STAY,P,ASP,ASPN)   00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C*****SUNOCO STANDS FOR SUN/ORBIT CONSTRAINT --                         00000030
C                                                                       00000040
C     SUBROUTINE SUNOCO (RES,A,E,INC,NODE,ARGP,ANOMA,STAY,P,ASP,ASPN)   00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF SUNOCO IS TO COMPUTE THE ANGLE AT ANY GIVEN TIME   00000090
C         BETWEEN THE EARTH-SUN POSITION VECTOR AND THE INSTANTANEOUS   00000100
C         VELOCITY VECTOR OF A SATELLITE IN EARTH ORBIT.                00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          RES(3)    R*8      I      EARTH-TO-SUN POSITION VECTOR (KM)  00000190
C          A         R*8      I      ORBITAL SEMIMAJOR AXIS (KM)        00000200
C          E         R*8      I      ORBITAL ECCENTRICITY               00000210
C          INC       R*8      I      ORBITAL INCLINATION (RADIANS)      00000220
C          NODE      R*8      I      RIGHT ASCENSION OF THE ASCENDING   00000230
C                                       NODE (RADIANS)                  00000240
C          ARGP      R*8      I      ARGUMENT OF PERIGEE (RADIANS)      00000250
C          ANOMA     R*8      I      TRUE ANOMALY AT SOME REFERENCE TIME00000260
C                                       (E.G. TIME OF INSERTION),       00000270
C                                       IN RADIANS                      00000280
C          STAY      R*8      I      TIME (IN MINUTES SINCE REFERENCE   00000290
C                                       TIME) AT WHICH ANGLE IS DESIRED 00000300
C          P         R*8      I      ORBITAL PERIOD (MINUTES)           00000310
C          ASP       R*8      O      ANGLE BETWEEN RES AND SATELLITE    00000320
C                                       VELOCITY VECTOR AT TIME STAY    00000330
C                                       (DEGREES)                       00000340
C          ASPN      R*8      O      ANGLE BETWEEN RES AND NEGATIVE OF  00000350
C                                       SATELLITE VELOCITY VECTOR AT    00000360
C                                       TIME STAY (DEGREES)             00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     SUNOCO IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000410
C                                                                       00000420
C         LAUCON                                                        00000430
C                                                                       00000440
C                                                                       00000450
C     THE FOLLOWING SUBROUTINES ARE CALLED BY SUNOCO.                   00000460
C                                                                       00000470
C         ELMREC    JOHANN    MEANOM    VERTEX                          00000480
C                                                                       00000490
C                                                                       00000500
C                                                                       00000510
C     SUNOCO NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000520
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000530
C                                                                       00000540
C                                                                       00000550
C                                                                       00000560
      REAL*8 INC,NODE                                                   00000570
      DIMENSION RES(3),X(3),V(3)                                        00000580
      DATA PI,DR/       3.1415926535897932D0,0.017453292519943D0/       00000590
      DATA TWOPI, TOL,PTOL/ 6.2831853071795864D0,1.D-4,1.D-7/           00000600
C                                                                       00000610
C *** IF THE TIME OF INTEREST CORRESPONDS TO APOGEE OR PERIGEE, SKIP    00000620
C     OVER THE ANOMALY CALCULATIONS.                                    00000630
      IF (DABS(P-STAY) .LT. PTOL) GO TO 10                              00000640
      IF ((DABS(P/2.D0-STAY) .LT. PTOL)  .AND.                          00000650
     2    ((ANOMA .EQ. 0.D0) .OR. (ANOMA .EQ. PI))) GO TO 20            00000660
C                                                                       00000670
C*****COMPUTE MEAN ANOMALY AT TIME OF INTEREST. CONVERT TO DEGREES.     00000680
      CALL MEANOM (E,ANOMA,DUMMY,AMEAN)                                 00000690
      AMEAN =(AMEAN + TWOPI*STAY/P) / DR                                00000700
C*****COMPUTE CORRESPONDING TRUE ANOMALY. CONVERT TO RADIANS.           00000710
      CALL JOHANN (E,AMEAN,TOL,TA,K)                                    00000720
      TA = TA*DR                                                        00000730
      GO TO 30                                                          00000740
C                                                                       00000750
   10 TA = ANOMA                                                        00000760
      GO TO 30                                                          00000770
   20 TA = PI - ANOMA                                                   00000780
C                                                                       00000790
C*****COMPUTE SAT. INSTANTANEOUS VELOCITY VECTOR AT TIME OF INTEREST.   00000800
   30 CALL ELMREC (A,E,INC,NODE,ARGP,TA,V,VMAG,0,X,DUMMY)               00000810
C                                                                       00000820
C*****COMPUTE DESIRED ASPECT ANGLES.                                    00000830
      CALL VERTEX (RES,V,ASP,ASPN)                                      00000840
      RETURN                                                            00000850
      END                                                               00000860
C          DATA SET SUNVEC     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE SUNVEC (JSDAY,DAY,TIME,RES)                            00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE SUNVEC (JSDAY,DAY,TIME,RES)                            00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF SUNVEC IS TO CHOOSE THE SUN POSITION VECTOR MOST   00000090
C         APPLICABLE TO A GIVEN DATE AND TIME FROM A SUN EPHEMERIS AT   00000100
C         HALF-DAY INTERVALS.                                           00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          JSDAY     I*4      I      NUMBER OF WHOLE DAYS SINCE 1950.0  00000190
C                                       TO FIRST DAY IN THE SUN         00000200
C                                       EPHEMERIS (INTEGER)             00000210
C          DAY       R*8      I      NUMBER OF WHOLE DAYS SINCE 1950.0  00000220
C                                       TO DAY FOR WHICH SUN POSITION   00000230
C                                       VECTOR IS DESIRED               00000240
C          TIME      R*8      I      TIME ON THAT DAY (HOURS)           00000250
C          RES(3)    R*8      O      EARTH-TO-SUN POSITION VECTOR AT THE00000260
C                                       NOON OR MIDNIGHT CLOSEST TO DAY 00000270
C                                       AND TIME (KM)                   00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     SUNVEC IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000320
C                                                                       00000330
C         LAUCON                                                        00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     NO SUBROUTINES ARE CALLED BY SUNVEC.                              00000380
C                                                                       00000390
C                                                                       00000400
C                                                                       00000410
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000420
C                                                                       00000430
C         COMMON VARIABLES USED                                         00000440
C                                                                       00000450
C         SUN(3,1020)                                                   00000460
C                                                                       00000470
C                                                                       00000480
C                                                                       00000490
C *** COMMON/SOLAR/SUN(3,1020)  (I)  SUN POSITION EPHEMERIS GENERATED   00000500
C                                    BY SUBROUTINE SUNEPH -- UP TO 510  00000510
C                                    DAYS AT  1/2-DAY INTERVALS         00000520
C                                                                       00000530
      COMMON/SOLAR/SUN(3,1020)                                          00000540
      DIMENSION RES(3)                                                  00000550
      JJJ = DAY                                                         00000560
      MM  = 2 * (JJJ-JSDAY) + 1                                         00000570
      DO 5 K=1,3                                                        00000580
      IF (TIME .LE. (6.D0+(K-1)*12.D0))  GO TO 10                       00000590
    5 MM = MM + 1                                                       00000600
   10 DO 15 K=1,3                                                       00000610
   15 RES(K) = SUN(K,MM)                                                00000620
      RETURN                                                            00000630
      END                                                               00000640
C          DATA SET TFRAC      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE TFRAC (TWI,TFI,TWO,TFO)                                00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE TFRAC (TWI,TFI,TWO,TFO)                                00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF TFRAC IS TO SUPPLY THE INTEGRAL AND FRACTIONAL     00000090
C         PARTS OF THE SUM OF TWO NUMBERS.                              00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          TWI       R*8      I      FIRST NUMBER                       00000180
C          TFI       R*8      I      SECOND NUMBER                      00000190
C          TWO       R*8      O      INTEGER PART OF TWI + TFI          00000200
C          TFO       R*8      O      FRACTIONAL PART OF TWI + TFI       00000210
C                                       (.LT.1.0)                       00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C     TFRAC IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000260
C                                                                       00000270
C         DATOUT    LAUCON                                              00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     NO SUBROUTINES ARE CALLED BY TFRAC.                               00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     TFRAC NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000360
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
      TWO = IDINT(TWI+TFI)                                              00000410
      TFO = TWI+TFI-TWO                                                 00000420
      RETURN                                                            00000430
      END                                                               00000440
C          DATA SET TIMEC      AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE TIMEC (YW,YF,TW,TF)                                    00000010
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000020
      DIMENSION Y(2),I(5),J(11)                                         00000030
      DATA  J    /31,59,90,120,151,181,212,243,273,304,334 /            00000040
C                                                                       00000050
C                                                                       00000060
C     SUBROUTINE TIMEC (YW,YF,TW,TF)                                    00000070
C                                                                       00000080
C                                                                       00000090
C                                                                       00000100
C     THE PURPOSE OF TIMEC IS TO CONVERT A CALENDAR DATE AND THE TIME ON00000110
C         THAT DATE TO THE NUMBER OF WHOLE AND FRACTIONAL DAYS SINCE    00000120
C         1950.0 (JANUARY 1,1950, 0 HOUR, 0 MINUTE, 0.0 SECOND).        00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          YW        R*8      I      YEAR, MONTH,AND DAY (YYYMM.DD)     00000210
C          YF        R*8      I      HOUR, MINUTE, AND SECOND (HHMM.SS) 00000220
C          TW        R*8      O      WHOLE DAYS SINCE 1950.0            00000230
C          TF        R*8      O      FRACTIONAL DAYS                    00000240
C                                                                       00000250
C                                                                       00000260
C                                                                       00000270
C     TIMEC IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000280
C                                                                       00000290
C         MODE DRIVERS                                                  00000300
C                                                                       00000310
C                                                                       00000320
C                                                                       00000330
C     NO SUBROUTINES ARE CALLED BY TIMEC.                               00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     TIMEC NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000380
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C********DETERMINE IF INPUT FALLS WITHIN LIMITS (1950.0-2099,INCLUSIVE) 00000430
C                                                                       00000440
      JJ = 1                                                            00000450
      I(1) = 100.D0*YW+.5D0                                             00000460
      Y(1) = YF                                                         00000470
      IF (I(1) .LT. 500000)  GO TO 2                                    00000480
      JJ = 6                                                            00000490
      IF (I(1) .GE. 2000000)  GO TO 2                                   00000500
      JJ = 11                                                           00000510
      IF (Y(1) .LT. 0.D0)  GO TO 2                                      00000520
      I(2) = Y(1)                                                       00000530
      IF (I(2).GE.2400) GO TO 2                                         00000540
      I(3) = I(2)/100                                                   00000550
      I(4) = I(2)-100*I(3)                                              00000560
      IF (I(4).GE.60) GO TO 2                                           00000570
      Y(1) = Y(1)-DFLOAT(I(2))                                          00000580
      IF (Y(1) .LE. .6D0) GO TO 10                                      00000590
    2 IF(JJ.EQ.1)WRITE(6,100)                                           00000600
      IF(JJ.EQ.6)WRITE(6,600)                                           00000610
      IF(JJ.EQ.11)WRITE(6,1100)                                         00000620
      TW=0.D0                                                           00000630
      TF=0.D0                                                           00000640
      GO TO 999                                                         00000650
C                                                                       00000660
C********COMPUTE TF                                                     00000670
C                                                                       00000680
   10 Y(2) = 60*(I(4)+60*I(3))                                          00000690
      TF   = (Y(2)+100.D0*Y(1))/86400.D0                                00000700
C                                                                       00000710
C********COMPUTE TW                                                     00000720
C                                                                       00000730
      I(2) = I(1)/100                                                   00000740
      I(3) = I(1)-100*I(2)-1                                            00000750
      I(4) = I(2)/100                                                   00000760
      I(1) = I(2)-100*I(4)-1                                            00000770
      IF (I(1) .GT. 11) GO TO 2                                         00000780
      IF (I(1)) 2,13,12                                                 00000790
   12 JJ = I(1)                                                         00000800
      I(3) = I(3)+J(JJ)                                                 00000810
   13 I(5) = I(4)-4*(I(4)/4)                                            00000820
      IF (I(1)/2+I(5).LE.0) I(3)=I(3)-1                                 00000830
      TW = I(3)+(2+1461*(I(4)-50))/4                                    00000840
  100 FORMAT(6X,'TIMEC WARNING MESSAGE. DATE BEFORE 1950.0.')           00000850
  600 FORMAT(6X,'TIMEC WARNING MESSAGE. DATE 2100 OR LATER.')           00000860
 1100 FORMAT(6X,'TIMEC WARNING -- ERROR IN FORMAT')                     00000870
  999 RETURN                                                            00000880
      END                                                               00000890
C          DATA SET TITLE1     AT LEVEL 001 AS OF 11/08/78
      SUBROUTINE TITLE1 (MODE,N)                                        00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE TITLE1 (MODE,N)                                        00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF TITLE1 IS TO ASSOCIATE EACH MODE1 OUTPUT PARAMETER 00000100
C         CODE NUMBER WITH A LITERAL-FIELD TITLE (USED AS A COLUMN HEAD-00000110
C         ING IN THE PRINTOUT). TITLE1 THEN CALLS OUTFLO, THE ROUTINE   00000120
C         WHICH SETS UP PRINTER OUTPUT.                                 00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          MODE      I*4      I      OPERATING MODE                     00000210
C          N         I*4      O      TOTAL NUMBER OF OUTPUT PARAMETERS  00000220
C                                       FROM WHICH USER CAN CHOOSE      00000230
C                                       (N=100*NUMBER OF ORBITS IN THIS 00000240
C                                       MODE)                           00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     TITLE1 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000290
C                                                                       00000300
C         MODE1                                                         00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     THE FOLLOWING SUBROUTINE IS CALLED BY TITLE1.                     00000350
C                                                                       00000360
C         OUTFLO                                                        00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     TITLE1 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000410
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C *** H ARRAY (PASSED TO OUTFLO) IS MADE UP OF   GROUPS OF 100 PAIRS OF 00000460
C     OUTPUT PARAM TITLES & CODE NUMBERS -- 1 GROUP FOR EACH ORBIT.     00000470
C     W/IN EACH GROUP, THE 1ST 20 PAIRS ARE FOR MISCELLANEOUS OUTPUT,   00000480
C                      THE 2ND 30 ARE FOR OUTPUT FROM 'INSERT' ROUTINE, 00000490
C                      THE 3RD 50 ARE FOR OUTPUT FROM 'LAUCON' ROUTINE. 00000500
      DIMENSION H1A(2,20),         H1B(2,30),         H1C(2,50)         00000510
      DIMENSION H(2,100)                                                00000520
      EQUIVALENCE (H1A(1,1),H(1,1)),                  (H1B(1,1),H(1,21))00000530
     2           ,(H1C(1,1),H(1,51))                                    00000540
C                                                                       00000550
C *** ORBIT 1 -- MISCELLANEOUS OUTPUT                                   00000560
C                                                                       00000570
      DATA H1A/ '  DATE  ',101.,   '  TIN   ',102.,   '   A1   ',103.,  00000580
     2          '   E1   ',104.,   '   I1   ',105.,   '  NOD1  ',106.,  00000590
     3          '  AOP1  ',107.,   ' TRUE1  ',108.,   '   P1   ',109.,  00000600
     4          ' ELAPSE ',110.,   '  GMTL  ',111.,   '        ',112.,  00000610
     5          '        ',113.,   '        ',114.,   '        ',115.,  00000620
     6          '        ',116.,   '        ',117.,   '        ',118.,  00000630
     7          '        ',119.,   '        ',120./                     00000640
C                                                                       00000650
C *** INSERTION INTO ORBIT 1 -- 'INSERT' DOES NOT APPLY                 00000660
C                                                                       00000670
      DATA H1B/ 60*'        '/                                          00000680
      DO 1 KAY=121,150                                                  00000690
      XKAY = KAY                                                        00000700
    1 H1B(2,KAY-120) = XKAY                                             00000710
C                                                                       00000720
C *** ORBIT 1 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00000730
C                                                                       00000740
      DATA H1C/ '  P1IN1 ',151.,   ' P1DUR1 ',152.,   '  P2IN1 ',153.,  00000750
     2          ' P2DUR1 ',154.,   ' PTDUR1 ',155.,   '  U1IN1 ',156.,  00000760
     3          ' U1DUR1 ',157.,   ' U2IN1  ',158.,   ' U2DUR1 ',159.,  00000770
     4          ' UTDUR1 ',160.,   'MAXSEP1 ',161.,   'MINSEP1 ',162.,  00000780
     5          'APOSEP1 ',163.,   'TFPSEP1 ',164.,   '        ',165.,  00000790
     6          '        ',166.,   '        ',167.,   '        ',168.,  00000800
     7          '        ',169.,   '        ',170.,   '        ',171.,  00000810
     8          '        ',172.,   '        ',173.,   '        ',174.,  00000820
     9          '        ',175.,   '        ',176.,   '        ',177.,  00000830
     *          '        ',178.,   '        ',179.,   '        ',180.,  00000840
     1          '        ',181.,   '        ',182.,   '        ',183.,  00000850
     2          '        ',184.,   '        ',185.,   '        ',186.,  00000860
     3          '        ',187.,   '        ',188.,   '        ',189.,  00000870
     4          '        ',190.,   '        ',191.,   '        ',192.,  00000880
     5          '        ',193.,   '        ',194.,   '        ',195.,  00000890
     6          '        ',196.,   '        ',197.,   '        ',198.,  00000900
     7          '        ',199.,   '        ',200./                     00000910
C                                                                       00000920
      IF (MODE .NE. 1) WRITE (6,1000)                                   00000930
      N = 100                                                           00000940
      CALL OUTFLO(H,N)                                                  00000950
      RETURN                                                            00000960
 1000 FORMAT (1H1,'*****SUBROUTINE TITLE1 WARNING MESSAGE -- MODE .NE. 100000970
     2. PROBLEMS MAY ARISE IN RECOGNIZING OUTPUT CODE NUMBERS IN OUTFLO 00000980
     3ROUTINE.')                                                        00000990
      END                                                               00001000
C          DATA SET TITLE2     AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE TITLE2 (MODE,N)                                        00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE TITLE2 (MODE,N)                                        00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF TITLE2 IS TO ASSOCIATE EACH MODE2 OUTPUT PARAMETER 00000100
C         CODE NUMBER WITH A LITERAL-FIELD TITLE (USED AS A COLUMN HEAD-00000110
C         ING IN THE PRINTOUT). TITLE2 THEN CALLS OUTFLO, THE ROUTINE   00000120
C         WHICH SETS UP PRINTER OUTPUT.                                 00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          MODE      I*4      I      OPERATING MODE                     00000210
C          N         I*4      O      TOTAL NUMBER OF OUTPUT PARAMETERS  00000220
C                                       FROM WHICH USER CAN CHOOSE      00000230
C                                       (N=100*NUMBER OF ORBITS IN THIS 00000240
C                                       MODE)                           00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     TITLE2 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000290
C                                                                       00000300
C         MODE2                                                         00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     THE FOLLOWING SUBROUTINE IS CALLED BY TITLE2.                     00000350
C                                                                       00000360
C         OUTFLO                                                        00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     TITLE2 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000410
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C *** H ARRAY (PASSED TO OUTFLO) IS MADE UP OF 2 GROUPS OF 100 PAIRS OF 00000460
C     OUTPUT PARAM TITLES & CODE NUMBERS -- 1 GROUP FOR EACH ORBIT.     00000470
C     W/IN EACH GROUP, THE 1ST 20 PAIRS ARE FOR MISCELLANEOUS OUTPUT,   00000480
C                      THE 2ND 30 ARE FOR OUTPUT FROM 'INSERT' ROUTINE, 00000490
C                      THE 3RD 50 ARE FOR OUTPUT FROM 'LAUCON' ROUTINE. 00000500
      DIMENSION H1A(2,20),         H1B(2,30),         H1C(2,50)         00000510
      DIMENSION H2A(2,20),         H2B(2,30),         H2C(2,50)         00000520
      DIMENSION H(2,200)                                                00000530
      EQUIVALENCE (H1A(1,1),H(1,1)),                  (H1B(1,1),H(1,21))00000540
     2           ,(H1C(1,1),H(1,51)),                (H2A(1,1),H(1,101))00000550
     3           ,(H2B(1,1),H(1,121)),               (H2C(1,1),H(1,151))00000560
C                                                                       00000570
C *** ORBIT 1 -- MISCELLANEOUS OUTPUT                                   00000580
C                                                                       00000590
      DATA H1A/ '  DATE  ',101.,   '  TIN   ',102.,   '   A1   ',103.,  00000600
     2          '   E1   ',104.,   '   I1   ',105.,   '  NOD1  ',106.,  00000610
     3          '  AOP1  ',107.,   ' TRUE1  ',108.,   '   P1   ',109.,  00000620
     4          ' ELAPSE ',110.,   '  GMTL  ',111.,   '        ',112.,  00000630
     5          '        ',113.,   '        ',114.,   '        ',115.,  00000640
     6          '        ',116.,   '        ',117.,   '        ',118.,  00000650
     7          '        ',119.,   '        ',120./                     00000660
C                                                                       00000670
C *** INSERTION INTO ORBIT 1 -- 'INSERT' DOES NOT APPLY                 00000680
C                                                                       00000690
      DATA H1B/ 60*'        '/                                          00000700
      DO 1 KAY=121,150                                                  00000710
      XKAY = KAY                                                        00000720
    1 H1B(2,KAY-120) = XKAY                                             00000730
C                                                                       00000740
C *** ORBIT 1 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00000750
C                                                                       00000760
      DATA H1C/ '  P1IN1 ',151.,   ' P1DUR1 ',152.,   '  P2IN1 ',153.,  00000770
     2          ' P2DUR1 ',154.,   ' PTDUR1 ',155.,   '  U1IN1 ',156.,  00000780
     3          ' U1DUR1 ',157.,   ' U2IN1  ',158.,   ' U2DUR1 ',159.,  00000790
     4          ' UTDUR1 ',160.,   'MAXSEP1 ',161.,   'MINSEP1 ',162.,  00000800
     5          'APOSEP1 ',163.,   'TFPSEP1 ',164.,   '        ',165.,  00000810
     6          '        ',166.,   '        ',167.,   '        ',168.,  00000820
     7          '        ',169.,   '        ',170.,   '        ',171.,  00000830
     8          '        ',172.,   '        ',173.,   '        ',174.,  00000840
     9          '        ',175.,   '        ',176.,   '        ',177.,  00000850
     *          '        ',178.,   '        ',179.,   '        ',180.,  00000860
     1          '        ',181.,   '        ',182.,   '        ',183.,  00000870
     2          '        ',184.,   '        ',185.,   '        ',186.,  00000880
     3          '        ',187.,   '        ',188.,   '        ',189.,  00000890
     4          '        ',190.,   '        ',191.,   '        ',192.,  00000900
     5          '        ',193.,   '        ',194.,   '        ',195.,  00000910
     6          '        ',196.,   '        ',197.,   '        ',198.,  00000920
     7          '        ',199.,   '        ',200./                     00000930
C                                                                       00000940
C *** ORBIT 2 -- MISCELLANEOUS OUTPUT                                   00000950
C                                                                       00000960
      DATA H2A/ ' DATE2  ',201.,   '  TIN2  ',202.,   '   A2   ',203.,  00000970
     2          '   E2   ',204.,   '   I2   ',205.,   '  NOD2  ',206.,  00000980
     3          '  AOP2  ',207.,   ' TRUE2  ',208.,   '   P2   ',209.,  00000990
     4          '        ',210.,   '        ',211.,   '        ',212.,  00001000
     5          '        ',213.,   '        ',214.,   '        ',215.,  00001010
     6          '        ',216.,   '        ',217.,   '        ',218.,  00001020
     7          '        ',219.,   '        ',220./                     00001030
C                                                                       00001040
C *** INSERTION INTO ORBIT 2 -- PARAMETERS OUTPUT FROM 'INSERT'         00001050
C                                                                       00001060
      DATA H2B/ '  PHI1  ',221.,   ' RINS2  ',222.,   '  TA12  ',223.,  00001070
     2          ' STAY1  ',224.,   ' VA12 X ',225.,   ' VA12 Y ',226.,  00001080
     3          ' VA12 Z ',227.,   ' VB12 X ',228.,   ' VB12 Y ',229.,  00001090
     4          ' VB12 Z ',230.,   'DELV12 X',231.,   'DELV12 Y',232.,  00001100
     5          'DELV12 Z',233.,   '  DV2   ',234.,   '  RA12  ',235.,  00001110
     6          ' DECL12 ',236.,   ' RA12N  ',237.,   'DECL12N ',238.,  00001120
     7          '        ',239.,   '        ',240.,   '        ',241.,  00001130
     8          '        ',242.,   '        ',243.,   '        ',244.,  00001140
     9          '        ',245.,   '        ',246.,   '        ',247.,  00001150
     *          '        ',248.,   '        ',249.,   '        ',250./  00001160
C                                                                       00001170
C *** ORBIT 2 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00001180
C                                                                       00001190
      DATA H2C/ ' P1IN2  ',251.,   ' P1DUR2 ',252.,   ' P2IN2  ',253.,  00001200
     2          ' P2DUR2 ',254.,   ' PTDUR2 ',255.,   ' U1IN2  ',256.,  00001210
     3          ' U1DUR2 ',257.,   ' U2IN2  ',258.,   ' U2DUR2 ',259.,  00001220
     4          ' UTDUR2 ',260.,   'MAXSEP2 ',261.,   'MINSEP2 ',262.,  00001230
     5          'APOSEP2 ',263.,   'TFPSEP2 ',264.,   'MXSEP2R1',265.,  00001240
     6          'MNSEP2R1',266.,   'APSEP2R1',267.,   'TPSEP2R1',268.,  00001250
     7          '  ASP2  ',269.,   ' ASP2R1 ',270.,   'APOGEO2 ',271.,  00001260
     8          'PERGEO2 ',272.,   ' PCDR12 ',273.,   ' UCDR12 ',274.,  00001270
     9          '        ',275.,   '        ',276.,   '        ',277.,  00001280
     *          '        ',278.,   '        ',279.,   '        ',280.,  00001290
     1          '        ',281.,   '        ',282.,   '        ',283.,  00001300
     2          '        ',284.,   '        ',285.,   '        ',286.,  00001310
     3          '        ',287.,   '        ',288.,   '        ',289.,  00001320
     4          '        ',290.,   '        ',291.,   '        ',292.,  00001330
     5          '        ',293.,   '        ',294.,   '        ',295.,  00001340
     6          '        ',296.,   '        ',297.,   '        ',298.,  00001350
     7          '        ',299.,   '        ',300./                     00001360
C                                                                       00001370
      IF (MODE .NE. 2) WRITE (6,1000)                                   00001380
      N = 200                                                           00001390
      CALL OUTFLO(H,N)                                                  00001400
      RETURN                                                            00001410
 1000 FORMAT (1H1,'*****SUBROUTINE TITLE2 WARNING MESSAGE -- MODE .NE. 200001420
     2. PROBLEMS MAY ARISE IN RECOGNIZING OUTPUT CODE NUMBERS IN OUTFLO 00001430
     3ROUTINE.')                                                        00001440
      END                                                               00001450
C          DATA SET TITL3      AT LEVEL 001 AS OF 01/05/78
      SUBROUTINE TITLE3 (MODE,N)                                        00001
      IMPLICIT REAL*8 (A-H,O-Z)                                         00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE TITLE3 (MODE,N)                                        00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF TITLE3 IS TO ASSOCIATE EACH MODE3 OUTPUT PARAMETER 00009
C         CODE NUMBER WITH A LITERAL-FIELD TITLE (USED AS A COLUMN HEAD-00010
C         ING IN THE PRINTOUT). TITLE3 THEN CALLS OUTFLO, THE ROUTINE   00011
C         WHICH SETS UP PRINTER OUTPUT.                                 00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/O        DEFINITION                      00018
C                                                                       00019
C          MODE      I*4      I      OPERATING MODE                     00020
C          N         I*4      O      TOTAL NUMBER OF OUTPUT PARAMETERS  00021
C                                       FROM WHICH USER CAN CHOOSE      00022
C                                       (N=100*NUMBER OF ORBITS IN THIS 00023
C                                       MODE)                           00024
C                                                                       00025
C                                                                       00026
C                                                                       00027
C     TITLE3 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00028
C                                                                       00029
C         MODE3                                                         00030
C                                                                       00031
C                                                                       00032
C                                                                       00033
C     THE FOLLOWING SUBROUTINE IS CALLED BY TITLE3.                     00034
C                                                                       00035
C         OUTFLO                                                        00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
C     TITLE3 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00040
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
C *** H ARRAY (PASSED TO OUTFLO) IS MADE UP OF 3 GROUPS OF 100 PAIRS OF 00045
C     OUTPUT PARAM TITLES & CODE NUMBERS -- 1 GROUP FOR EACH ORBIT.     00046
C     W/IN EACH GROUP, THE 1ST 20 PAIRS ARE FOR MISCELLANEOUS OUTPUT,   00047
C                      THE 2ND 30 ARE FOR OUTPUT FROM 'INSERT' ROUTINE, 00048
C                      THE 3RD 50 ARE FOR OUTPUT FROM 'LAUCON' ROUTINE. 00049
      DIMENSION H1A(2,20),         H1B(2,30),         H1C(2,50)         00050
      DIMENSION H2A(2,20),         H2B(2,30),         H2C(2,50)         00051
      DIMENSION H3A(2,20),         H3B(2,30),         H3C(2,50)         00052
      DIMENSION H(2,300)                                                00053
      EQUIVALENCE (H1A(1,1),H(1,1)),                  (H1B(1,1),H(1,21))00054
     2           ,(H1C(1,1),H(1,51)),                (H2A(1,1),H(1,101))00055
     3           ,(H2B(1,1),H(1,121)),               (H2C(1,1),H(1,151))00056
     4           ,(H3A(1,1),H(1,201)),               (H3B(1,1),H(1,221))00057
     5           ,(H3C(1,1),H(1,251))                                   00058
C                                                                       00059
C *** ORBIT 1 -- MISCELLANEOUS OUTPUT                                   00060
C                                                                       00061
      DATA H1A/ '  DATE  ',101.,   '  TIN   ',102.,   '   A1   ',103.,  00062
     2          '   E1   ',104.,   '   I1   ',105.,   '  NOD1  ',106.,  00063
     3          '  AOP1  ',107.,   ' TRUE1  ',108.,   '   P1   ',109.,  00064
     4          ' ELAPSE ',110.,   '  GMTL  ',111.,   '        ',112.,  00065
     5          '        ',113.,   '        ',114.,   '        ',115.,  00066
     6          '        ',116.,   '        ',117.,   '        ',118.,  00067
     7          '        ',119.,   '        ',120./                     00068
C                                                                       00069
C *** INSERTION INTO ORBIT 1 -- 'INSERT' DOES NOT APPLY                 00070
C                                                                       00071
      DATA H1B/ 60*'        '/                                          00072
      DO 1 KAY=121,150                                                  00073
      XKAY = KAY                                                        00074
    1 H1B(2,KAY-120) = XKAY                                             00075
C                                                                       00076
C *** ORBIT 1 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00077
C                                                                       00078
      DATA H1C/ '  P1IN1 ',151.,   ' P1DUR1 ',152.,   '  P2IN1 ',153.,  00079
     2          ' P2DUR1 ',154.,   ' PTDUR1 ',155.,   '  U1IN1 ',156.,  00080
     3          ' U1DUR1 ',157.,   ' U2IN1  ',158.,   ' U2DUR1 ',159.,  00081
     4          ' UTDUR1 ',160.,   ' MAXSEP1',161.,   ' MINSEP1',162.,  00082
     5          ' APOSEP1',163.,   ' TFPSEP1',164.,   '        ',165.,  00083
     6          '        ',166.,   '        ',167.,   '        ',168.,  00084
     7          '        ',169.,   '        ',170.,   '        ',171.,  00085
     8          '        ',172.,   '        ',173.,   '        ',174.,  00086
     9          '        ',175.,   '        ',176.,   '        ',177.,  00087
     *          '        ',178.,   '        ',179.,   '        ',180.,  00088
     1          '        ',181.,   '        ',182.,   '        ',183.,  00089
     2          '        ',184.,   '        ',185.,   '        ',186.,  00090
     3          '        ',187.,   '        ',188.,   '        ',189.,  00091
     4          '        ',190.,   '        ',191.,   '        ',192.,  00092
     5          '        ',193.,   '        ',194.,   '        ',195.,  00093
     6          '        ',196.,   '        ',197.,   '        ',198.,  00094
     7          '        ',199.,   '        ',200./                     00095
C                                                                       00096
C *** ORBIT 2 -- MISCELLANEOUS OUTPUT                                   00097
C                                                                       00098
      DATA H2A/ ' DATE2  ',201.,   '  TIN2  ',202.,   '   A2   ',203.,  00099
     2          '   E2   ',204.,   '   I2   ',205.,   '  NOD2  ',206.,  00100
     3          '  AOP2  ',207.,   ' TRUE2  ',208.,   '   P2   ',209.,  00101
     4          '        ',210.,   '        ',211.,   '        ',212.,  00102
     5          '        ',213.,   '        ',214.,   '        ',215.,  00103
     6          '        ',216.,   '        ',217.,   '        ',218.,  00104
     7          '        ',219.,   '        ',220./                     00105
C                                                                       00106
C *** INSERTION INTO ORBIT 2 -- PARAMETERS OUTPUT FROM 'INSERT'         00107
C                                                                       00108
      DATA H2B/ '  PHI1  ',221.,   ' RINS2  ',222.,   '  TA12  ',223.,  00109
     2          ' STAY1  ',224.,   ' VA12 X ',225.,   ' VA12 Y ',226.,  00110
     3          ' VA12 Z ',227.,   ' VB12 X ',228.,   ' VB12 Y ',229.,  00111
     4          ' VB12 Z ',230.,   'DELV12 X',231.,   'DELV12 Y',232.,  00112
     5          'DELV12 Z',233.,   '  DV2   ',234.,   '  RA12  ',235.,  00113
     6          ' DECL12 ',236.,   '  RA12N ',237.,   ' DECL12N',238.,  00114
     7          '        ',239.,   '        ',240.,   '        ',241.,  00115
     8          '        ',242.,   '        ',243.,   '        ',244.,  00116
     9          '        ',245.,   '        ',246.,   '        ',247.,  00117
     *          '        ',248.,   '        ',249.,   '        ',250./  00118
C                                                                       00119
C *** ORBIT 2 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00120
C                                                                       00121
      DATA H2C/ ' P1IN2  ',251.,   ' P1DUR2 ',252.,   ' P2IN2  ',253.,  00122
     2          ' P2DUR2 ',254.,   ' PTDUR2 ',255.,   ' U1IN2  ',256.,  00123
     3          ' U1DUR2 ',257.,   ' U2IN2  ',258.,   ' U2DUR2 ',259.,  00124
     4          ' UTDUR2 ',260.,   ' MAXSEP2',261.,   ' MINSEP2',262.,  00125
     5          ' APOSEP2',263.,   ' TFPSEP2',264.,   'MXSEP2R1',265.,  00126
     6          'MNSEP2R1',266.,   'APSEP2R1',267.,   'TPSEP2R1',268.,  00127
     7          '  ASP2  ',269.,   ' ASP2R1 ',270.,   'APOGEO2 ',271.,  00128
     8          'PERGEO2 ',272.,   ' PCDR12 ',273.,   ' UCDR12 ',274.,  00129
     9          'FBAD2   ',275.,   '        ',276.,   '        ',277.,  00130
     *          '        ',278.,   '        ',279.,   '        ',280.,  00131
     1          '        ',281.,   '        ',282.,   '        ',283.,  00132
     2          '        ',284.,   '        ',285.,   '        ',286.,  00133
     3          '        ',287.,   '        ',288.,   '        ',289.,  00134
     4          '        ',290.,   '        ',291.,   '        ',292.,  00135
     5          '        ',293.,   '        ',294.,   '        ',295.,  00136
     6          '        ',296.,   '        ',297.,   '        ',298.,  00137
     7          '        ',299.,   '        ',300./                     00138
C                                                                       00139
C *** ORBIT 3 -- MISCELLANEOUS OUTPUT                                   00140
C                                                                       00141
      DATA H3A/ ' DATE3  ',301.,   '  TIN3  ',302.,   '   A3   ',303.,  00142
     2          '   E3   ',304.,   '   I3   ',305.,   '  NOD3  ',306.,  00143
     3          '  AOP3  ',307.,   ' TRUE3  ',308.,   '   P3   ',309.,  00144
     4          '        ',310.,   '        ',311.,   '        ',312.,  00145
     5          '        ',313.,   '        ',314.,   '        ',315.,  00146
     6          '        ',316.,   '        ',317.,   '        ',318.,  00147
     7          '        ',319.,   '        ',320./                     00148
C                                                                       00149
C *** INSERTION INTO ORBIT 3 -- PARAMETERS OUTPUT FROM 'INSERT'         00150
C                                                                       00151
      DATA H3B/ '  PHI2  ',321.,   ' RINS3  ',322.,   '  TA23  ',323.,  00152
     2          ' STAY2  ',324.,   ' VA23 X ',325.,   ' VA23 Y ',326.,  00153
     3          ' VA23 Z ',327.,   ' VB23 X ',328.,   ' VB23 Y ',329.,  00154
     4          ' VB23 Z ',330.,   'DELV23 X',331.,   'DELV23 Y',332.,  00155
     5          'DELV23 Z',333.,   '  DV3   ',334.,   '  RA23  ',335.,  00156
     6          ' DECL23 ',336.,   '  RA23N ',337.,   ' DECL23N',338.,  00157
     7          '        ',339.,   '        ',340.,   '        ',341.,  00158
     8          '        ',342.,   '        ',343.,   '        ',344.,  00159
     9          '        ',345.,   '        ',346.,   '        ',347.,  00160
     *          '        ',348.,   '        ',349.,   '        ',350./  00161
C                                                                       00162
C *** ORBIT 3 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00163
C                                                                       00164
      DATA H3C/ ' P1IN3  ',351.,   ' P1DUR3 ',352.,   ' P2IN3  ',353.,  00165
     2          ' P2DUR3 ',354.,   ' PTDUR3 ',355.,   ' U1IN3  ',356.,  00166
     3          ' U1DUR3 ',357.,   ' U2IN3  ',358.,   ' U2DUR3 ',359.,  00167
     4          ' UTDUR3 ',360.,   ' MAXSEP3',361.,   ' MINSEP3',362.,  00168
     5          ' APOSEP3',363.,   ' TFPSEP3',364.,   'MXSEP3R1',365.,  00169
     6          'MNSEP3R1',366.,   'APSEP3R1',367.,   'TPSEP3R1',368.,  00170
     7          '  ASP3  ',369.,   ' ASPN3  ',370.,   ' ASP3R1 ',371.,  00171
     8          ' ASPN3R1',372.,   ' ASP3DEP',373.,   'ASPN3DEP',374.,  00172
     9          '        ',375.,   '        ',376.,   '        ',377.,  00173
     *          '        ',378.,   '        ',379.,   '        ',380.,  00174
     1          '        ',381.,   '        ',382.,   '        ',383.,  00175
     2          '        ',384.,   '        ',385.,   '        ',386.,  00176
     3          '        ',387.,   '        ',388.,   '        ',389.,  00177
     4          '        ',390.,   '        ',391.,   '        ',392.,  00178
     5          '        ',393.,   '        ',394.,   '        ',395.,  00179
     6          '        ',396.,   '        ',397.,   '        ',398.,  00180
     7          '        ',399.,   '        ',400./                     00181
C                                                                       00182
      IF (MODE .NE. 3) WRITE (6,1000)                                   00183
      N = 300                                                           00184
      CALL OUTFLO(H,N)                                                  00185
      RETURN                                                            00186
 1000 FORMAT (1H1,'*****SUBROUTINE TITLE3 WARNING MESSAGE -- MODE .NE. 300187
     2. PROBLEMS MAY ARISE IN RECOGNIZING OUTPUT CODE NUMBERS IN OUTFLO 00188
     3ROUTINE.')                                                        00189
      END                                                               00190
C          DATA SET TITLE4     AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE TITLE4 (MODE,N)                                        00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE TITLE4 (MODE,N)                                        00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF TITLE4 IS TO ASSOCIATE EACH MODE4 OUTPUT PARAMETER 00000100
C         CODE NUMBER WITH A LITERAL-FIELD TITLE (USED AS A COLUMN HEAD-00000110
C         ING IN THE PRINTOUT). TITLE4 THEN CALLS OUTFLO, THE ROUTINE   00000120
C         WHICH SETS UP PRINTER OUTPUT.                                 00000130
C                                                                       00000140
C                                                                       00000150
C                                                                       00000160
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000170
C                                                                       00000180
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000190
C                                                                       00000200
C          MODE      I*4      I      OPERATING MODE                     00000210
C          N         I*4      O      TOTAL NUMBER OF OUTPUT PARAMETERS  00000220
C                                       FROM WHICH USER CAN CHOOSE      00000230
C                                       (N=100*NUMBER OF ORBITS IN THIS 00000240
C                                       MODE)                           00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     TITLE4 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000290
C                                                                       00000300
C         MODE4                                                         00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     THE FOLLOWING SUBROUTINE IS CALLED BY TITLE4.                     00000350
C                                                                       00000360
C         OUTFLO                                                        00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
C     TITLE4 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000410
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000420
C                                                                       00000430
C                                                                       00000440
C                                                                       00000450
C *** H ARRAY (PASSED TO OUTFLO) IS MADE UP OF 4 GROUPS OF 100 PAIRS OF 00000460
C     OUTPUT PARAM TITLES & CODE NUMBERS -- 1 GROUP FOR EACH ORBIT.     00000470
C     W/IN EACH GROUP, THE 1ST 20 PAIRS ARE FOR MISCELLANEOUS OUTPUT,   00000480
C                      THE 2ND 30 ARE FOR OUTPUT FROM 'INSERT' ROUTINE, 00000490
C                      THE 3RD 50 ARE FOR OUTPUT FROM 'LAUCON' ROUTINE. 00000500
      DIMENSION H1A(2,20),         H1B(2,30),         H1C(2,50)         00000510
      DIMENSION H2A(2,20),         H2B(2,30),         H2C(2,50)         00000520
      DIMENSION H3A(2,20),         H3B(2,30),         H3C(2,50)         00000530
      DIMENSION H4A(2,20),         H4B(2,30),         H4C(2,50)         00000540
      DIMENSION H(2,400)                                                00000550
      EQUIVALENCE (H1A(1,1),H(1,1)),                  (H1B(1,1),H(1,21))00000560
     2           ,(H1C(1,1),H(1,51)),                (H2A(1,1),H(1,101))00000570
     3           ,(H2B(1,1),H(1,121)),               (H2C(1,1),H(1,151))00000580
     4           ,(H3A(1,1),H(1,201)),               (H3B(1,1),H(1,221))00000590
     5           ,(H3C(1,1),H(1,251)),       (H4A(1,1),H(1,301)),       00000600
     6        (H4B(1,1),H(1,321)),         (H4C(1,1),H(1,351))          00000610
C                                                                       00000620
C *** ORBIT 1 -- MISCELLANEOUS OUTPUT                                   00000630
C                                                                       00000640
      DATA H1A/ '  DATE  ',101.,   '  TIN   ',102.,   '   A1   ',103.,  00000650
     2          '   E1   ',104.,   '   I1   ',105.,   '  NOD1  ',106.,  00000660
     3          '  AOP1  ',107.,   ' TRUE1  ',108.,   '   P1   ',109.,  00000670
     4          ' ELAPSE ',110.,   '  GMTL  ',111.,   '        ',112.,  00000680
     5          '        ',113.,   '        ',114.,   '        ',115.,  00000690
     6          '        ',116.,   '        ',117.,   '        ',118.,  00000700
     7          '        ',119.,   '        ',120./                     00000710
C                                                                       00000720
C *** INSERTION INTO ORBIT 1 -- 'INSERT' DOES NOT APPLY                 00000730
C                                                                       00000740
      DATA H1B/ 60*'        '/                                          00000750
      DO 1 KAY=121,150                                                  00000760
      XKAY = KAY                                                        00000770
    1 H1B(2,KAY-120) = XKAY                                             00000780
C                                                                       00000790
C *** ORBIT 1 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00000800
C                                                                       00000810
      DATA H1C/ '  P1IN1 ',151.,   ' P1DUR1 ',152.,   '  P2IN1 ',153.,  00000820
     2          ' P2DUR1 ',154.,   ' PTDUR1 ',155.,   '  U1IN1 ',156.,  00000830
     3          ' U1DUR1 ',157.,   ' U2IN1  ',158.,   ' U2DUR1 ',159.,  00000840
     4          ' UTDUR1 ',160.,   'MAXSEP1 ',161.,   'MINSEP1 ',162.,  00000850
     5          'APOSEP1 ',163.,   'TFPSEP1 ',164.,   '        ',165.,  00000860
     6          '        ',166.,   '        ',167.,   '        ',168.,  00000870
     7          '        ',169.,   '        ',170.,   '        ',171.,  00000880
     8          '        ',172.,   '        ',173.,   '        ',174.,  00000890
     9          '        ',175.,   '        ',176.,   '        ',177.,  00000900
     *          '        ',178.,   '        ',179.,   '        ',180.,  00000910
     1          '        ',181.,   '        ',182.,   '        ',183.,  00000920
     2          '        ',184.,   '        ',185.,   '        ',186.,  00000930
     3          '        ',187.,   '        ',188.,   '        ',189.,  00000940
     4          '        ',190.,   '        ',191.,   '        ',192.,  00000950
     5          '        ',193.,   '        ',194.,   '        ',195.,  00000960
     6          '        ',196.,   '        ',197.,   '        ',198.,  00000970
     7          '        ',199.,   '        ',200./                     00000980
C                                                                       00000990
C *** ORBIT 2 -- MISCELLANEOUS OUTPUT                                   00001000
C                                                                       00001010
      DATA H2A/ ' DATE2  ',201.,   '  TIN2  ',202.,   '   A2   ',203.,  00001020
     2          '   E2   ',204.,   '   I2   ',205.,   '  NOD2  ',206.,  00001030
     3          '  AOP2  ',207.,   ' TRUE2  ',208.,   '   P2   ',209.,  00001040
     4          '        ',210.,   '        ',211.,   '        ',212.,  00001050
     5          '        ',213.,   '        ',214.,   '        ',215.,  00001060
     6          '        ',216.,   '        ',217.,   '        ',218.,  00001070
     7          '        ',219.,   '        ',220./                     00001080
C                                                                       00001090
C *** INSERTION INTO ORBIT 2 -- PARAMETERS OUTPUT FROM 'INSERT'         00001100
C                                                                       00001110
      DATA H2B/ '  PHI1  ',221.,   ' RINS2  ',222.,   '  TA12  ',223.,  00001120
     2          ' STAY1  ',224.,   ' VA12 X ',225.,   ' VA12 Y ',226.,  00001130
     3          ' VA12 Z ',227.,   ' VB12 X ',228.,   ' VB12 Y ',229.,  00001140
     4          ' VB12 Z ',230.,   'DELV12 X',231.,   'DELV12 Y',232.,  00001150
     5          'DELV12 Z',233.,   '  DV2   ',234.,   '  RA12  ',235.,  00001160
     6          ' DECL12 ',236.,   ' RA12N  ',237.,   'DECL12N ',238.,  00001170
     7          '        ',239.,   '        ',240.,   '        ',241.,  00001180
     8          '        ',242.,   '        ',243.,   '        ',244.,  00001190
     9          '        ',245.,   '        ',246.,   '        ',247.,  00001200
     *          '        ',248.,   '        ',249.,   '        ',250./  00001210
C                                                                       00001220
C *** ORBIT 2 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00001230
C                                                                       00001240
      DATA H2C/ ' P1IN2  ',251.,   ' P1DUR2 ',252.,   ' P2IN2  ',253.,  00001250
     2          ' P2DUR2 ',254.,   ' PTDUR2 ',255.,   ' U1IN2  ',256.,  00001260
     3          ' U1DUR2 ',257.,   ' U2IN2  ',258.,   ' U2DUR2 ',259.,  00001270
     4          ' UTDUR2 ',260.,   'MAXSEP2 ',261.,   'MINSEP2 ',262.,  00001280
     5          'APOSEP2 ',263.,   'TFPSEP2 ',264.,   'MXSEP2R1',265.,  00001290
     6          'MNSEP2R1',266.,   'APSEP2R1',267.,   'TPSEP2R1',268.,  00001300
     7          '  ASP2  ',269.,   ' ASP2R1 ',270.,   'APOGEO2 ',271.,  00001310
     8          'PERGEO2 ',272.,   ' PCDR12 ',273.,   ' UCDR12 ',274.,  00001320
     9          '        ',275.,   '        ',276.,   '        ',277.,  00001330
     *          '        ',278.,   '        ',279.,   '        ',280.,  00001340
     1          '        ',281.,   '        ',282.,   '        ',283.,  00001350
     2          '        ',284.,   '        ',285.,   '        ',286.,  00001360
     3          '        ',287.,   '        ',288.,   '        ',289.,  00001370
     4          '        ',290.,   '        ',291.,   '        ',292.,  00001380
     5          '        ',293.,   '        ',294.,   '        ',295.,  00001390
     6          '        ',296.,   '        ',297.,   '        ',298.,  00001400
     7          '        ',299.,   '        ',300./                     00001410
C                                                                       00001420
C *** ORBIT 3 -- MISCELLANEOUS OUTPUT                                   00001430
C                                                                       00001440
      DATA H3A/ ' DATE3  ',301.,   '  TIN3  ',302.,   '   A3   ',303.,  00001450
     2          '   E3   ',304.,   '   I3   ',305.,   '  NOD3  ',306.,  00001460
     3          '  AOP3  ',307.,   ' TRUE3  ',308.,   '   P3   ',309.,  00001470
     4          '        ',310.,   '        ',311.,   '        ',312.,  00001480
     5          '        ',313.,   '        ',314.,   '        ',315.,  00001490
     6          '        ',316.,   '        ',317.,   '        ',318.,  00001500
     7          '        ',319.,   '        ',320./                     00001510
C                                                                       00001520
C *** INSERTION INTO ORBIT 3 -- PARAMETERS OUTPUT FROM 'INSERT'         00001530
C                                                                       00001540
      DATA H3B/ '  PHI2  ',321.,   ' RINS3  ',322.,   '  TA23  ',323.,  00001550
     2          ' STAY2  ',324.,   ' VA23 X ',325.,   ' VA23 Y ',326.,  00001560
     3          ' VA23 Z ',327.,   ' VB23 X ',328.,   ' VB23 Y ',329.,  00001570
     4          ' VB23 Z ',330.,   'DELV23 X',331.,   'DELV23 Y',332.,  00001580
     5          'DELV23 Z',333.,   '  DV3   ',334.,   '  RA23  ',335.,  00001590
     6          ' DECL23 ',336.,   ' RA23N  ',337.,   'DECL23N ',338.,  00001600
     7          '        ',339.,   '        ',340.,   '        ',341.,  00001610
     8          '        ',342.,   '        ',343.,   '        ',344.,  00001620
     9          '        ',345.,   '        ',346.,   '        ',347.,  00001630
     *          '        ',348.,   '        ',349.,   '        ',350./  00001640
C                                                                       00001650
C *** ORBIT 3 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00001660
C                                                                       00001670
      DATA H3C/ ' P1IN3  ',351.,   ' P1DUR3 ',352.,   ' P2IN3  ',353.,  00001680
     2          ' P2DUR3 ',354.,   ' PTDUR3 ',355.,   ' U1IN3  ',356.,  00001690
     3          ' U1DUR3 ',357.,   ' U2IN3  ',358.,   ' U2DUR3 ',359.,  00001700
     4          ' UTDUR3 ',360.,   'MAXSEP3 ',361.,   'MINSEP3 ',362.,  00001710
     5          'APOSEP3 ',363.,   'TFPSEP3 ',364.,   'MXSEP3R1',365.,  00001720
     6          'MNSEP3R1',366.,   'APSEP3R1',367.,   'TPSEP3R1',368.,  00001730
     7          '  ASP3  ',369.,   '  ASPN3 ',370.,   '  ASP3R1',371.,  00001740
     8          'ASPN3R1 ',372.,   'ASP3DEP ',373.,   'ASPN3DEP',374.,  00001750
     9          '        ',375.,   '        ',376.,   '        ',377.,  00001760
     *          '        ',378.,   '        ',379.,   '        ',380.,  00001770
     1          '        ',381.,   '        ',382.,   '        ',383.,  00001780
     2          '        ',384.,   '        ',385.,   '        ',386.,  00001790
     3          '        ',387.,   '        ',388.,   '        ',389.,  00001800
     4          '        ',390.,   '        ',391.,   '        ',392.,  00001810
     5          '        ',393.,   '        ',394.,   '        ',395.,  00001820
     6          '        ',396.,   '        ',397.,   '        ',398.,  00001830
     7          '        ',399.,   '        ',400./                     00001840
C                                                                       00001850
C *** ORBIT 4 -- MISCELLANEOUS OUTPUT                                   00001860
C                                                                       00001870
      DATA H4A/ ' DATE4  ',401.,   '  TIN4  ',402.,   '   A4   ',403.,  00001880
     2          '   E4   ',404.,   '   I4   ',405.,   '  NOD4  ',406.,  00001890
     3          '  AOP4  ',407.,   '  TRUE4 ',408.,   '   P4   ',409.,  00001900
     4          '        ',410.,   '        ',411.,   '        ',412.,  00001910
     5          '        ',413.,   '        ',414.,   '        ',415.,  00001920
     6          '        ',416.,   '        ',417.,   '        ',418.,  00001930
     7          '        ',419.,   '        ',420./                     00001940
C                                                                       00001950
C *** INSERTION INTO ORBIT 4 -- 'INSERT' DOES NOT APPLY. SPACE IS AVAIL-00001960
C                                ABLE FOR 30 OUTPUT PARAMETERS.         00001970
      DATA H4B/ '        ',421.,   '        ',422.,   '        ',423.,  00001980
     2          '        ',424.,   '        ',425.,   '        ',426.,  00001990
     3          '        ',427.,   '        ',428.,   '        ',429.,  00002000
     4          '        ',430.,   '        ',431.,   '        ',432.,  00002010
     5          '        ',433.,   '        ',434.,   '        ',435.,  00002020
     6          '        ',436.,   '        ',437.,   '        ',438.,  00002030
     7          '        ',439.,   '        ',440.,   '        ',441.,  00002040
     8          '        ',442.,   '        ',443.,   '        ',444.,  00002050
     9          '        ',445.,   '        ',446.,   '        ',447.,  00002060
     *          '        ',448.,   '        ',449.,   '        ',450./  00002070
C                                                                       00002080
C *** ORBIT 4 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00002090
C                                                                       00002100
      DATA H4C/ ' P1IN4  ',451.,   ' P1DUR4 ',452.,   ' P2IN4  ',453.,  00002110
     2          ' P2DUR4 ',454.,   ' PTDUR4 ',455.,   ' U1IN4  ',456.,  00002120
     3          ' U1DUR4 ',457.,   ' U2IN4  ',458.,   ' U2DUR4 ',459.,  00002130
     4          ' UTDUR4 ',460.,   ' MAXSEP4',461.,   ' MINSEP4',462.,  00002140
     5          ' APOSEP4',463.,   ' TFPSEP4',464.,   'MXSEP4R1',465.,  00002150
     6          'MNSEP4R1',466.,   'APSEP4R1',467.,   'TPSEP4R1',468.,  00002160
     7          '  ASP4  ',469.,   '  ASPN4 ',470.,   '        ',471.,  00002170
     8          '        ',472.,   '        ',473.,   '        ',474.,  00002180
     9          '        ',475.,   '        ',476.,   '        ',477.,  00002190
     *          '        ',478.,   '        ',479.,   '        ',480.,  00002200
     1          '        ',481.,   '        ',482.,   '        ',483.,  00002210
     2          '        ',484.,   '        ',485.,   '        ',486.,  00002220
     3          '        ',487.,   '        ',488.,   '        ',489.,  00002230
     4          '        ',490.,   '        ',491.,   '        ',492.,  00002240
     5          '        ',493.,   '        ',494.,   '        ',495.,  00002250
     6          '        ',496.,   '        ',497.,   '        ',498.,  00002260
     7          '        ',499.,   '        ',500./                     00002270
      IF (MODE .NE. 4) WRITE (6,1000)                                   00002280
      N = 400                                                           00002290
      CALL OUTFLO(H,N)                                                  00002300
      RETURN                                                            00002310
 1000 FORMAT (1H1,'*****SUBROUTINE TITLE4 WARNING MESSAGE -- MODE .NE. 400002320
     2. PROBLEMS MAY ARISE IN RECOGNIZING OUTPUT CODE NUMBERS IN OUTFLO 00002330
     3ROUTINE.')                                                        00002340
      END                                                               00002350
C          DATA SET TITLE5     AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE TITLE5 (MODE,N)                                        00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE TITLE5 (MODE,N)                                        00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF TITLE5 IS TO ASSOCIATE EACH MODE5 OUTPUT PARAMETER 00000090
C         CODE NUMBER WITH A LITERAL-FIELD TITLE (USED AS A COLUMN HEAD-00000100
C         ING IN THE PRINTOUT). TITLE5 THEN CALLS OUTFLO, THE ROUTINE   00000110
C         WHICH SETS UP PRINTER OUTPUT.                                 00000120
C                                                                       00000130
C                                                                       00000140
C                                                                       00000150
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000160
C                                                                       00000170
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000180
C                                                                       00000190
C          MODE      I*4      I      OPERATING MODE                     00000200
C          N         I*4      O      TOTAL NUMBER OF OUTPUT PARAMETERS  00000210
C                                       FROM WHICH USER CAN CHOOSE      00000220
C                                       (N=100*NUMBER OF ORBITS IN THIS 00000230
C                                       MODE)                           00000240
C                                                                       00000250
C                                                                       00000260
C                                                                       00000270
C     TITLE5 IS CALLED BY THE FOLLOWING SUBROUTINE.                     00000280
C                                                                       00000290
C         MODE5                                                         00000300
C                                                                       00000310
C                                                                       00000320
C                                                                       00000330
C     THE FOLLOWING SUBROUTINE IS CALLED BY TITLE5.                     00000340
C                                                                       00000350
C         OUTFLO                                                        00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     TITLE5 NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000400
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000410
C                                                                       00000420
C                                                                       00000430
C *** H ARRAY (PASSED TO OUTFLO) IS MADE UP OF 100 PAIRS OF             00000440
C     OUTPUT PARAM TITLES & CODE NUMBERS.                               00000450
C                      THE 1ST 20 PAIRS ARE FOR MISCELLANEOUS OUTPUT,   00000460
C                      THE 2ND 30 ARE FOR OUTPUT FROM 'INSERT' ROUTINE, 00000470
C                      THE 3RD 50 ARE FOR OUTPUT FROM 'LAUCON' ROUTINE. 00000480
      DIMENSION H1A(2,20),         H1B(2,30),         H1C(2,50)         00000490
      DIMENSION H(2,100)                                                00000500
      EQUIVALENCE (H1A(1,1),H(1,1)),                  (H1B(1,1),H(1,21))00000510
     2           ,(H1C(1,1),H(1,51))                                    00000520
C                                                                       00000530
C *** ORBIT 1 -- MISCELLANEOUS OUTPUT                                   00000540
C                                                                       00000550
      DATA H1A/ '  DATE  ',101.,   '  TIN   ',102.,   '   A1   ',103.,  00000560
     2          '   E1   ',104.,   '   I1   ',105.,   '  NOD1  ',106.,  00000570
     3          '  AOP1  ',107.,   ' TRUE1  ',108.,   '   P1   ',109.,  00000580
     4          ' ELAPSE ',110.,   '  GMTL  ',111.,   '        ',112.,  00000590
     5          '        ',113.,   '        ',114.,   '        ',115.,  00000600
     6          '        ',116.,   '        ',117.,   '        ',118.,  00000610
     7          '        ',119.,   '        ',120./                     00000620
C                                                                       00000630
C *** INSERTION INTO ORBIT 1 -- 'INSERT' DOES NOT APPLY                 00000640
C                                                                       00000650
      DATA H1B/ 60*'        '/                                          00000660
      DO 1 KAY=121,150                                                  00000670
      XKAY = KAY                                                        00000680
    1 H1B(2,KAY-120) = XKAY                                             00000690
C                                                                       00000700
C *** ORBIT 1 CONSTRAINED-PARAMETER OUTPUT FROM 'LAUCON'                00000710
C                                                                       00000720
      DATA H1C/ '  P1IN1 ',151.,   ' P1DUR1 ',152.,   '  P2IN1 ',153.,  00000730
     2          ' P2DUR1 ',154.,   ' PTDUR1 ',155.,   '  U1IN1 ',156.,  00000740
     3          ' U1DUR1 ',157.,   ' U2IN1  ',158.,   ' U2DUR1 ',159.,  00000750
     4          ' UTDUR1 ',160.,   ' MAXSEP1',161.,   ' MINSEP1',162.,  00000760
     5          ' APOSEP1',163.,   ' TFPSEP1',164.,   '  ASP1  ',165.,  00000770
     6          '  ASPN1 ',166.,   '        ',167.,   '        ',168.,  00000780
     7          '        ',169.,   '        ',170.,   '        ',171.,  00000790
     8          '        ',172.,   '        ',173.,   '        ',174.,  00000800
     9          '        ',175.,   '        ',176.,   '        ',177.,  00000810
     *          '        ',178.,   '        ',179.,   '        ',180.,  00000820
     1          '        ',181.,   '        ',182.,   '        ',183.,  00000830
     2          '        ',184.,   '        ',185.,   '        ',186.,  00000840
     3          '        ',187.,   '        ',188.,   '        ',189.,  00000850
     4          '        ',190.,   '        ',191.,   '        ',192.,  00000860
     5          '        ',193.,   '        ',194.,   '        ',195.,  00000870
     6          '        ',196.,   '        ',197.,   '        ',198.,  00000880
     7          '        ',199.,   '        ',200./                     00000890
C                                                                       00000900
      IF (MODE .NE. 5) WRITE (6,1000)                                   00000910
      N = 100                                                           00000920
      CALL OUTFLO (H,N)                                                 00000930
      RETURN                                                            00000940
 1000 FORMAT (1H1,'*****SUBROUTINE TITLE5 WARNING MESSAGE -- MODE .NE. 500000950
     2. PROBLEMS MAY ARISE IN RECOGNIZING OUTPUT CODE NUMBERS IN OUTFLO 00000960
     3ROUTINE.')                                                        00000970
      END                                                               00000980
C          DATA SET UPELM      AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE UPELM(B,TT,NB,NK)                                      00000010
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE UPELM (B,TT,NB,NK)                                     00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF UPELM IS TO UPDATE THE MEAN ORBITAL ELEMENTS IN    00000090
C         TIME FROM ONE EPOCH TO ANOTHER.                               00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          B(20)     R*8      I      ARRAY OF CONSTANTS FOR A GIVEN     00000180
C                                       CELESTIAL BODY. B AND T (SEE    00000190
C                                       COMMON VARIABLES) ARE USED TO   00000200
C                                       COMPUTE EL, THE UPDATED ORBITAL 00000210
C                                       ELEMENTS. (UNITS OF B MUST BE   00000220
C                                       CHOSEN TO BE COMPATIBLE WITH TT)00000230
C          TT        R*8      I      DESIRED EPOCH (JULIAN CENTURIES    00000240
C                                       SINCE 1900.0)                   00000250
C          NB(5)     I*4      I     NB(I)+1 IS THE NUMBER OF TERMS IN   00000260
C                                       EL(I)                           00000270
C          NK        I*4      I     KEY FOR TIME DERIVATIVE COMPUTATION.00000280
C                                       FOR NK.LE.0, COMPUTE EL(1-5).   00000290
C                                       FOR NK.GT.0, COMPUTE EL(1-10.   00000300
C                                                                       00000310
C                                                                       00000320
C                                                                       00000330
C     UPELM IS CALLED BY THE FOLLOWING SUBROUTINE.                      00000340
C                                                                       00000350
C         APEFEM                                                        00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
C     NO SUBROUTINES ARE CALLED BY UPELM.                               00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000440
C                                                                       00000450
C         COMMON VARIABLES COMPUTED                                     00000460
C                                                                       00000470
C           EL(10)                                                      00000480
C           T(4)                                                        00000490
C                                                                       00000500
C                                                                       00000510
      COMMON/APCOM/T(4),EL(10)                                          00000520
      DIMENSION B(1),NB(1)                                              00000530
      DATA TP/0.D0/                                                     00000540
      IF(TT.EQ.TP) GO TO 1                                              00000550
      T(1)=1.0D0                                                        00000560
      T(2)=TT                                                           00000570
      T(3)=T(2)**2                                                      00000580
      T(4)=T(3)*T(2)                                                    00000590
    1 K=0                                                               00000600
      DO 2 I=1,10                                                       00000610
      EL(I)=0.D0                                                        00000620
    2 CONTINUE                                                          00000630
      DO 6 I=1,5                                                        00000640
      J=I+5                                                             00000650
      N=NB(I)                                                           00000660
      IF(N) 6,3,3                                                       00000670
    3 K=K+1                                                             00000680
      EL(I)=B(K)                                                        00000690
      IF(N.EQ.0) GO TO 6                                                00000700
    4 CON=1.D0                                                          00000710
      DO 5 L=1,N                                                        00000720
      K=K+1                                                             00000730
      EL(I)=EL(I) + B(K)*T(L+1)                                         00000740
      IF(NK.LE.0) GO TO 5                                               00000750
      EL(J)=EL(J) + B(K)*CON*T(L)                                       00000760
      CON=CON + 1.D0                                                    00000770
    5 CONTINUE                                                          00000780
    6 CONTINUE                                                          00000790
      TP=TT                                                             00000800
      RETURN                                                            00000810
      END                                                               00000820
C          DATA SET VERTEX     AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE VERTEX (A,B,Q,QSUP)                                    00000010
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE VERTEX (A,B,Q,QSUP)                                    00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF VERTEX IS TO COMPUTE THE ANGLE (0 TO 180 DEGREES)  00000090
C         BETWEEN TWO VECTORS.                                          00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C         A(3),B(3)  R*8      I      TWO VECTORS                        00000180
C         Q          R*8      O      ANGLE BETWEEN THE VECTORS (DEGREES)00000190
C         QSUP       R*8      O      SUPPLEMENT OF Q                    00000200
C                                                                       00000210
C                                                                       00000220
C                                                                       00000230
C     VERTEX IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000240
C                                                                       00000250
C         LAUCON    SUNOCO                                              00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY VERTEX.            00000300
C                                                                       00000310
C         DOT                                                           00000320
C                                                                       00000330
C                                                                       00000340
C                                                                       00000350
C     VERTEX NEITHER USES NOR ALTERS VARIABLES IN COMMON.               00000360
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000370
C                                                                       00000380
C                                                                       00000390
C                                                                       00000400
      DIMENSION A(3),B(3)                                               00000410
      DATA DR,ONE80 /0.017453292519943D0,180.D0/                        00000420
      AMAG = DSQRT(A(1)*A(1)+A(2)*A(2)+A(3)*A(3))                       00000430
      BMAG = DSQRT(B(1)*B(1)+B(2)*B(2)+B(3)*B(3))                       00000440
      Q    =  ( DARCOS ( DOT(A,B) / (AMAG*BMAG) ) )  /  DR              00000450
      QSUP =  ONE80 - Q                                                 00000460
      RETURN                                                            00000470
      END                                                               00000480
C          DATA SET XPROD      AT LEVEL 001 AS OF 11/14/78
      SUBROUTINE XPROD(A,B,C,CMAG,JUNIT)                                00000010
      IMPLICIT REAL*8(A-H,O-Z)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE XPROD (A,B,C,CMAG,JUNIT)                               00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF XPROD IS TO TAKE EITHER THE CROSS PRODUCT OR THE   00000090
C         UNITIZED CROSS PRODUCT OF TWO VECTORS.                        00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          A(3)      R*8      I      FIRST VECTOR                       00000180
C          B(3)      R*8      I      SECOND VECTOR                      00000190
C          C(3)      R*8      O      IF JUNIT .NE. 1,                   00000200
C                                       C = A CROSS B                   00000210
C                                    IF JUNIT .EQ. 1,                   00000220
C                                       C = (A CROSS B)/CMAG            00000230
C          CMAG      R*8      O      MAGNITUDE OF A CROSS B             00000240
C          JUNIT     R*8      I      FLAG --                            00000250
C                                       .NE.1, COMPUTE CROSS PRODUCT    00000260
C                                       .EQ.1, COMPUTE UNITIZED CROSS   00000270
C                                              PRODUCT                  00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     XPROD IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000320
C                                                                       00000330
C         ARCO      DVEL      SEP                                       00000340
C         ARGROT    GEOM                                                00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     NO SUBROUTINES ARE CALLED BY XPROD.                               00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C     XPROD NEITHER USES NOR ALTERS VARIABLES IN COMMON.                00000430
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
      DIMENSION A(3),B(3),C(3)                                          00000480
      C(1)=A(2)*B(3)-A(3)*B(2)                                          00000490
      C(2)=A(3)*B(1)-A(1)*B(3)                                          00000500
      C(3)=A(1)*B(2)-A(2)*B(1)                                          00000510
      CMAG=DSQRT(C(1)*C(1)+C(2)*C(2)+C(3)*C(3))                         00000520
      IF(JUNIT.NE.1)RETURN                                              00000530
      DO 5 J=1,3                                                        00000540
    5 C(J)=C(J)/CMAG                                                    00000550
      RETURN                                                            00000560
      END                                                               00000570
